Bueno aqui mejore el codigo originalmente posteado, no se si sea mas rapido porque no lo probe con tantos registros, solo con los que el puso de ejemplo.

Utiliza la memoria para realizar el proceso y no necesita del archivo RUTS.txt aunque lo deje por si acaso. Hize un solo bucle para todo el proceso lo cual es mas rapido ya que antes dijiste que campo1 y 2 no son necesarios.

Suponiendo que el "rut" no se encuentra en los campos 1 o 2 hize este code:

 
Option Explicit
 
Private Sub Command1_Click()
 
    Dim DIRECCION As String
    Dim Sumatoria As String
    Dim Content() As String
    Dim I         As Long
    Dim Regs      As String
    Dim Llave     As String
    Dim Ruts      As String
    Dim V         As Integer
 
    If Dir$(App.Path & "\RUTS.txt") <> "" Then Kill App.Path & "\RUTS.txt"
 
    If Dir$(App.Path & "\ARCHIVO_FINAL.txt") <> "" Then Kill App.Path & "\ARCHIVO_FINAL.txt"
 
    cd.ShowOpen    ' abre una ventana para buscar el archivo base
    DIRECCION = cd.FileName   ' la direccion se guarda en una variable
 
    Open DIRECCION For Input As #1     ' abrimos el archivo               ' lo recorremos mientras no sea fin de archivo
 
    Content = Split(Input$(LOF(1), #1), vbCrLf)
 
    Close #1
 
    For I = LBound(Content) To UBound(Content)
 
        If Content(I) <> "" Then
 
            Llave = Mid$(Content(I), 58, 9)
            Sumatoria = Mid$(Content(I), 35, 8)
 
            If Llave <> "" Then
 
                V = InStr(1, Regs, Llave)
 
                If V = 0 Then
 
                    Regs = Regs & Llave & vbCrLf
                    Ruts = Ruts & Content(I) & vbCrLf
                    EscriveLog Llave, "RUTS"
 
                Else
 
                    V = InStr(1, Ruts, Llave)
                    Ruts = Replace$(Ruts, Mid$(Ruts, V - 23, 8), Format$(Val(Mid$(Ruts, V - 23, 8)) + Val(Sumatoria), "00000000"))
 
                End If
 
            End If
 
        End If
 
    Next
 
    Ruts = Mid$(Ruts, 1, Len(Ruts) - 2)
 
    EscriveLog Ruts, "ARCHIVO_FINAL"
    MsgBox "FIN"
 
End Sub
 
 

Modulo:

 
Public Function EscriveLog(ByRef Texto As String, ByRef tipo As String) ', ByRef xTipo As Byte)
 
    Dim strFile As String
    Dim fn      As Long
    Dim strLog  As String
 
    strFile = App.Path & "\" & tipo & ".txt"
    fn = FreeFile
    strLog = Texto
 
    Open strFile For Append As fn
 
    Print #fn, strLog
 
    Close fn
 
End Function
 
 

Seria bueno que subieras el archivo base original para ver que tanto podemos optimizar el code. (comprimido) si es que no pesa mucho.

y si usas split?

Buenas , esta vez tengo una pregunta y es que he buscado pero no he encontrado mucho, queria saber si es posible grabar los datos de una estructura UDT como string u otro tipo de variable, para luego cargar los datos de nuevo asignadolo al UDT. He visto que se puede grabar una UDT en un archivo binario, pero necesito que no sea en un archivo binario.

PD: Necesito espesificamente guardar los datos de la UDT en una campo de una base de datos, para luego poder leer esa UDT otra vez.

No exactamente porque la Funcion 1 es distinta de la 2 y si una cambia la otra no se ve afectada, el problema surge que cuando ejecuto las 2 o mas de 2 solo me analiza la ultima en ejecutar por tanto si Variable = 1 y la ultima funcion ejecutada es la 2 no sale del bucle la 1 y asi se queda.

La idea es permanecer en ambos bucles de ambas funciones por separado de modo que si la variable toma un valor u otro las funciones reaccionen deacuerdo a su condicion de bucle.

PD: le hechare un vistazo a los modulos de clase Saludos!

No manejo mucho los modulos de calse pero podrias dar un ejemplo de como lo harias? Aqui pongo un ejemplo de lo que quiero hacer:

En un form:

Option Explicit
 
Dim Variable            As Integer
 
Private Sub Command1_Click()
    Variable = 1
End Sub
 
Private Sub Command2_Click()
    Variable = 2
End Sub
 
Private Sub Form_Load()
    Timer1.Enabled = True
    Timer2.Enabled = True
    MsgBox "Se ejecutaron las funciones"
End Sub
 
Function Funcion1()
 
    Debug.Print "Empezo la funcion 1"
 
    Do
        WaitMessage
        DoEvents
    Loop Until Variable = 1
 
    MsgBox "Acabo la funcion 1 "
 
End Function
 
Function Funcion2()
 
    Debug.Print "Empezo la funcion 2"
 
    Do
        WaitMessage
        DoEvents
    Loop Until Variable = 2
 
    MsgBox "Acabo la funcion 2 "
 
End Function
 
Private Sub Timer1_Timer()
    Timer1.Enabled = False
    Call Funcion1
End Sub
 
Private Sub Timer2_Timer()
    Timer2.Enabled = False
    Call Funcion2
End Sub
 

Tengo 2 botones y dos funciones, los timers son para llamar a ambas funciones al mismo tiempo. Si se corre el ejemplo veran que las dos funciones inicializan pero la ultima en iniciar es la que se mantiene en el bucle mientras que la otra no.

Ejemplo si inicio la aplicacion y empieza la funcion1 y despues la funcion2 si aprieto el command1 que es el que modifica la variable para que salga de la funcion 1 no pasa nada pero si pulso el command2 si sale de la funcion 2 :S a ver si me pueden hechar una mano, he pensado en varias cosas pero no me sirven gracias de ante mano.

Buenas, tengo un inconveniente y no encuentro una solucion. Veran tengo una aplicacion que necesita ejecutar una funcion, esta funcion se debe mantener activa hasta que la en la aplicacion suceda algo por ejemplo que cambie una variable, en pequeño ejemplo:

Sub Funcion()
 
    ' La aplicacion activa un suceso, ejemplo activa un command botton.
 
    ' La aplicacion se mantiene en esta linea sin pasar a la siguiente linea hasta que
    ' una variable cambie de valor, cuando la variable cambia de valor entonces 
    ' pasa a la siguiente linea.
 
    ' Desactiva el suceso antes activado.
 
End Function

Esto yo lo habia logrado aplicando un doEvents junto con waitmessage, pero el problema surge cuando tengo que llamar dos veces a esa funcion, solo me ejecuta una a la vez, el doevents se mantiene en una funcion pero no me analiza la otra y esto me causa problemas, ya que ambas tienen condiciones diferentes, y si la condicion de una cambia mientras el bucle esta en la otra entonces se queda pegada esa funcion y no me sirve :S. Quisiera saber si saben alguna forma de solucionar esto o alguna alternativa que me sirva Gracias.

Saludos! XD!

Tengo este code en mis codes almacenados ( No es mia la funcion ), Espero que te sirva XD!

'---------------------------------------------------------------------------------------
' Module : mLocIP
' DateTime: 19/12/2009 08:55PM
' Author : Kresha7
' Mail: kresha7@hotmail.com
' Purpose : Gets Information about the location of an IP address
'---------------------------------------------------------------------------------------
Public Function LocateIP(IPAddr As String) As String
 
    Dim HTTP As Object
    Dim StrRes As String
    Dim IP As String, Region As String, Country As String, City As String, Latitude As String, Longitude As String, TZone As String, ISP As String, ConT As String
 
    Const URL = "http://www.ip2location.com/"
 
    Set HTTP = CreateObject("Winhttp.Winhttprequest.5.1")
 
    With HTTP
        .Open "POST", URL & IPAddr
        .Send
        StrRes = .ResponseText
    End With
 
    IP = Mid(Split(Split(StrRes, "dgLookup__ctl2_lblICountry")(1), "</span>")(0), 3)
    Region = Mid(Split(Split(StrRes, "dgLookup__ctl2_lblIRegion")(1), "</span>")(0), 3)
    Country = Mid(Split(Split(StrRes, "dgLookup__ctl2_lblICity")(1), "</span>")(0), 3)
    Latitude = Mid(Split(Split(StrRes, "dgLookup__ctl2_lblILatitude")(1), "</span>")(0), 3)
    Longitude = Mid(Split(Split(StrRes, "dgLookup__ctl2_lblILongitude")(1), "</span>")(0), 3)
    TZone = Mid(Split(Split(StrRes, "dgLookup__ctl2_lblITimeZone")(1), "</span>")(0), 3)
    ConT = Mid(Split(Split(StrRes, "dgLookup__ctl2_lblINetSpeed")(1), "</span>")(0), 3)
    ISP = Mid(Split(Split(StrRes, "dgLookup__ctl2_lblIISP")(1), "</span>")(0), 3)
    LocateIP = IP & vbNewLine & Region & vbNewLine & Country & vbNewLine & Latitude & vbNewLine & Longitude & vbNewLine & TZone & vbNewLine & ConT & vbNewLine & ISP
 
End Function
 

Buenas, he buscado en la web algun codigo o algo que me sirva para obtener un codigo unico para una maquina, que solo lo tenga esa maquina y ningun otra. Si alguien tiene algo que me ayude se agradece Saludos!

El link de descargar esta el source.

PD: Perdon por el doble post.