[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 511
  • Last Modified:

VBA Word/String search

I got help with some code here. It works great. It search for an id and path in the txt file and prints to the worksheet. The problem is it is print out like
"fax event: 30161      "is stored as \\FarrSQL\S0801160.010\d0804160.010
And i want  just
30161     \\FarrSQL\S0801160.010\d0804160.010
I don't understand some of the code to change it like
CadenasEntreCaracteres(FileCont, searchI, searchF).

I have attached the code that performs the work search. any help appreciated.Thanks


Private Sub getFiles()
    On Error Resume Next
    Dim aFiles() As String
    aFiles = filesInFolder(2008, 1)
    Dim j As Long, i As Long, n As Long
    
    
    Dim elementos As Long
    elementos = UBound(aFiles)
    
    If (Err.Number = 9) Then
        MsgBox "no files found"
        Exit Sub
    End If
    
    
    Dim FileCont As String
    Dim eventNumber() As String, uncPath() As String
    Dim eventNumber1() As String, uncPath1() As String
    Dim searchI As String, searchF As String
    
    n = 1
    For j = LBound(aFiles) To UBound(aFiles)
        'MsgBox aFiles(j)
        FileCont = FileContent(aFiles(j))
        
        searchI = "fax event: "
        searchF = vbCrLf
        eventNumber = CadenasEntreCaracteres(FileCont, searchI, searchF)
        
        
        searchI = "is stored as "
        searchF = vbCrLf
        uncPath = CadenasEntreCaracteres(FileCont, searchI, searchF)
        
        For i = LBound(eventNumber) To UBound(eventNumber)
            'MsgBox "file: " & aFiles(j) & vbCrLf & _
                "event number: " & eventNumber(i) & vbCrLf & _
                "unc path: " & uncPath(i)
            Cells(n, 1) = eventNumber(i)
            Cells(n, 2) = uncPath(i)
            
            
           n = n + 1
           i = i + 1
        Next
    
    
    Next
End Sub

Open in new window

0
j8547
Asked:
j8547
1 Solution
 
Serge FournierAnalyst ProgrammerCommented:
you obviously have other modules, with more code in it
like a sub called: "CadenasEntreCaracteres"

can you post the whole code?
merge all modules anyway (cut / past all sub in the same module)
0
 
irudykCommented:
The CadenasEntreCaracteres routine seems to put the text you don't want to see as part of the results.  So, without that code, I suppose you could strip the text you don't wan't after calling that routine/function.  Try the following revised code:
Private Sub getFiles()
    On Error Resume Next
    Dim aFiles() As String
    aFiles = filesInFolder(2008, 1)
    Dim j As Long, i As Long, n As Long
    
    
    Dim elementos As Long
    elementos = UBound(aFiles)
    
    If (Err.Number = 9) Then
        MsgBox "no files found"
        Exit Sub
    End If
    
    
    Dim FileCont As String
    Dim eventNumber() As String, uncPath() As String
    Dim eventNumber1() As String, uncPath1() As String
    Dim searchI As String, searchF As String
    
    n = 1
    For j = LBound(aFiles) To UBound(aFiles)
        'MsgBox aFiles(j)
        FileCont = FileContent(aFiles(j))
        
        searchI = "fax event: "
        searchF = vbCrLf
        eventNumber = CadenasEntreCaracteres(FileCont, searchI, searchF)
        eventNumber = Replace(eventNumber, searchI, "")
        
        
        searchI = "is stored as "
        searchF = vbCrLf
        uncPath = CadenasEntreCaracteres(FileCont, searchI, searchF)
        uncPath = Replace(uncPath, searchI, "")
        
        For i = LBound(eventNumber) To UBound(eventNumber)
            'MsgBox "file: " & aFiles(j) & vbCrLf & _
                "event number: " & eventNumber(i) & vbCrLf & _
                "unc path: " & uncPath(i)
            Cells(n, 1) = eventNumber(i)
            Cells(n, 2) = uncPath(i)
            
            
           n = n + 1
           i = i + 1
        Next
    
    
    Next
End Sub

Open in new window

0
 
borgunitCommented:
This is just a quick fix

line 42                Cells(n,1) = Mid$(eventNumber(i), InStr(eventNumber(i), ": ") + 2)
line 43                Cells(n,2) = Mid$(uncPath(i), InStr(UncPath(i), "\\") + 2)

It assumes the found info is always formatted the same way
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
j8547Author Commented:
Here is all the code. Do u know is CadenasEntreCaracteres a built in fuction. Can't get translation. Thanks for your help.

Private Sub getFiles()
    On Error Resume Next
    Dim aFiles() As String
    aFiles = filesInFolder(2008, 1)
    Dim j As Long, i As Long, n As Long
   
   
    Dim elementos As Long
    elementos = UBound(aFiles)
   
    If (Err.Number = 9) Then
        MsgBox "no files found"
        Exit Sub
    End If
   
   
    Dim FileCont As String
    Dim eventNumber() As String, uncPath() As String
    Dim eventNumber1() As String, uncPath1() As String
    Dim searchI As String, searchF As String
   
    n = 1
    For j = LBound(aFiles) To UBound(aFiles)
        'MsgBox aFiles(j)
        FileCont = FileContent(aFiles(j))
       
        searchI = "fax event: "
        searchF = vbCrLf
        eventNumber = CadenasEntreCaracteres(FileCont, searchI, searchF)
       
       
        searchI = "is stored as "
        searchF = vbCrLf
        uncPath = CadenasEntreCaracteres(FileCont, searchI, searchF)
       
        For i = LBound(eventNumber) To UBound(eventNumber)
            'MsgBox "file: " & aFiles(j) & vbCrLf & _
                "event number: " & eventNumber(i) & vbCrLf & _
                "unc path: " & uncPath(i)
            Cells(n, 1) = eventNumber(i)
            Cells(n, 2) = uncPath(i)
           
           
           n = n + 1
           i = i + 1
        Next
   
   
    Next
End Sub
 
Private Function FileContent(filePath As String) As String
    Dim fileNro As Integer
    fileNro = FreeFile
    Open filePath For Input As #fileNro
    FileContent = Input(LOF(fileNro), fileNro)
    Close #fileNro
End Function
 
Public Function CadenasEntreCaracteres(Cadena As String, _
caracterSepInicio As String, caracterSepFin As String) As String()
   
    Dim cadenas() As String
    Dim cantCad As Long
    Dim pos1 As Long, pos2 As Long
   
    cantCad = 0
    pos1 = 0
    pos1 = InStr(pos1 + 1, Cadena, caracterSepInicio)
    Do While pos1 > 0
        ReDim Preserve cadenas(cantCad)
        cadenas(cantCad) = Mid(Cadena, pos1, InStr(pos1, Cadena, caracterSepFin) - pos1 + 1)
       
        pos1 = InStr(pos1 + 1, Cadena, caracterSepInicio)
        cantCad = cantCad + 1
    Loop
    CadenasEntreCaracteres = cadenas
   
End Function
 
 
Private Function filesInFolder(year As Integer, month As Integer) As String()
    Dim strFolder As String
    Dim strPatern As String
    Dim sFile As String
    Dim strSubFolder As String
    Dim i As Long, j As Long, n As Long
    Dim aFiles() As String
   
    strPatern = year & Format(month, "00") & "*"
    strFolder = "F:\facsys Reporting\files\"
    strSubFolder = Dir(strFolder & strPatern, vbDirectory)
   
    Do While strSubFolder <> ""
        n = n + 1
        sFile = Dir(strFolder & strSubFolder & "\Receive.log", vbArchive)
       
        Do While sFile <> ""
            ReDim Preserve aFiles(i)
            aFiles(i) = strFolder & strSubFolder & "\" & sFile
            i = UBound(aFiles) + 1
           
            sFile = Dir   ' Obtiene siguiente entrada.
        Loop
       
        strSubFolder = Dir(strFolder & strPatern, vbDirectory)
       
       
       
        For j = 1 To n
            strSubFolder = Dir
           
        Next
    Loop
   
    filesInFolder = aFiles
     
   
End Function


0
 
irudykCommented:
Try the following code:
Public Function CadenasEntreCaracteres(strSearchText As String, _
strSearchFor As String, strSeperator As String) As String()
    
    Dim strSearchTextFound() As String
    Dim foundText As Long
    Dim pos1 As Long, pos2 As Long
    
    foundText = 0
    pos1 = 0
    pos1 = InStr(pos1 + 1, strSearchText, strSearchFor) + Len(strSearchFor)
    Do While pos1 > 0
        ReDim Preserve strSearchTextFound(foundText)
        strSearchTextFound(foundText) = Mid(strSearchText, pos1, InStr(pos1, strSearchText, strSeperator) - pos1 + 1)
        
        pos1 = InStr(pos1 + 1, strSearchText, strSearchFor)
        foundText = foundText + 1
    Loop
    CadenasEntreCaracteres = strSearchTextFound
    
End Function

Open in new window

0
 
j8547Author Commented:
This only worked for every second one. There is also a character symbol at the end of the line. This has always been here. Don't know how to remove it. I have attached the printout. Thanks for help
printout.bmp
0
 
irudykCommented:
Okay, try the following revised code:
Public Function CadenasEntreCaracteres(strSearchText As String, _
strSearchFor As String, strSeperator As String) As String()
    
    Dim strSearchTextFound() As String
    Dim foundText As Long
    Dim pos1 As Long, pos2 As Long
    
    foundText = 0
    pos1 = 0
    pos1 = InStr(pos1 + 1, strSearchText, strSearchFor) + Len(strSearchFor)
    Do While pos1 > 0
        ReDim Preserve strSearchTextFound(foundText)
        strSearchTextFound(foundText) = Mid(strSearchText, pos1, InStr(pos1, strSearchText, strSeperator) - pos1 + 1)
        
        pos1 = InStr(pos1 + 1, strSearchText, strSearchFor)
        If pos1 > 0 Then pos1 = pos1 + Len(strSearchFor)
        foundText = foundText + 1
    Loop
    CadenasEntreCaracteres = strSearchTextFound
    
End Function

Open in new window

0
 
j8547Author Commented:
This works but how do i get rid of the character symbol at the end of each string. Thanks
0
 
j8547Author Commented:
Also for some reason when i run it for some of the ID's the UNC path doesn't populate. I have looked at the log file and nothing seems to be any different to others that do copy. Would you have any reason why this would happen as i need them all to populate. Thanks
0
 
irudykCommented:
Okay, do you have a the log file that exhibits these issue that I could test on (since I can't seem to replicate your issues)?
0
 
j8547Author Commented:
Here is the log file.
Receive.log
0
 
irudykCommented:
Okay try the following revised code:
Private Sub getFiles()
 
    On Error Resume Next
    Dim aFiles() As String
    aFiles = filesInFolder(2008, 1)
    Dim j As Long, i As Long, n As Long
    Dim elementos As Long
    elementos = UBound(aFiles)
    
    If (Err.Number = 9) Then
        MsgBox "no files found"
        Exit Sub
    End If
    
    Dim FileCont As String
    Dim eventNumber() As String, uncPath() As String
    Dim eventNumber1() As String, uncPath1() As String
    Dim searchI As String, searchF As String
    
    n = 1
 
    For j = LBound(aFiles) To UBound(aFiles)
        'MsgBox aFiles(j)
        FileCont = FileContent(aFiles(j))
        
        searchI = "for receive fax event: "
        searchF = vbCrLf
        eventNumber = CadenasEntreCaracteres(FileCont, searchI, searchF)
        
        searchI = "is stored as "
        searchF = vbCrLf
        uncPath = CadenasEntreCaracteres(FileCont, searchI, searchF)
        
        For i = LBound(eventNumber) To UBound(eventNumber)
            'MsgBox "file: " & aFiles(j) & vbCrLf & _
                "event number: " & eventNumber(i) & vbCrLf & _
                "unc path: " & uncPath(i)
            Cells(n, 1) = eventNumber(i)
            Cells(n, 2) = uncPath(i)
            n = n + 1
        Next
    Next
 
End Sub
 
Private Function FileContent(filePath As String) As String
    Dim fileNro As Integer
    fileNro = FreeFile
    Open filePath For Input As #fileNro
    FileContent = Input(LOF(fileNro), fileNro)
    Close #fileNro
End Function
 
Public Function CadenasEntreCaracteres(strSearchText As String, _
strSearchFor As String, strSeperator As String) As String()
    
    Dim strSearchTextFound() As String
    Dim foundText As Long
    Dim pos1 As Long, pos2 As Long
    
    foundText = 0
    pos1 = 0
    pos1 = InStr(pos1 + 1, strSearchText, strSearchFor) + Len(strSearchFor)
    Do While pos1 > 0
        ReDim Preserve strSearchTextFound(foundText)
        strSearchTextFound(foundText) = Mid(strSearchText, pos1, InStr(pos1, strSearchText, strSeperator) - pos1)
        
        pos1 = InStr(pos1 + 1, strSearchText, strSearchFor)
        If pos1 > 0 Then pos1 = pos1 + Len(strSearchFor)
        foundText = foundText + 1
    Loop
    CadenasEntreCaracteres = strSearchTextFound
    
End Function
 
Private Function filesInFolder(year As Integer, month As Integer) As String()
    Dim strFolder As String
    Dim strPatern As String
    Dim sFile As String
    Dim strSubFolder As String
    Dim i As Long, j As Long, n As Long
    Dim aFiles() As String
    
    strPatern = year & Format(month, "00") & "*"
    strFolder = "F:\facsys Reporting\files\"
    strSubFolder = Dir(strFolder & strPatern, vbDirectory)
    
    Do While strSubFolder <> ""
        n = n + 1
        sFile = Dir(strFolder & strSubFolder & "\Receive.log", vbArchive)
        
        Do While sFile <> ""
            ReDim Preserve aFiles(i)
            aFiles(i) = strFolder & strSubFolder & "\" & sFile
            i = UBound(aFiles) + 1
            
            sFile = Dir   ' Obtiene siguiente entrada.
        Loop
        
        strSubFolder = Dir(strFolder & strPatern, vbDirectory)
 
        For j = 1 To n
            strSubFolder = Dir
            
        Next
    Loop
    
    filesInFolder = aFiles
 
End Function

Open in new window

0
 
j8547Author Commented:
that works perfectly now. Thanks. I just wanted to ask a quick question. What exactly does this do. Is this the function that finds the id and path. Also is CadenasEntreCaracteres a built - in function or can i chage it to english. Thanks for your help. Works exactly as i need it to.

Public Function CadenasEntreCaracteres(strSearchText As String, _
strSearchFor As String, strSeperator As String) As String()
   
    Dim strSearchTextFound() As String
    Dim foundText As Long
    Dim pos1 As Long, pos2 As Long
   
    foundText = 0
    pos1 = 0
    pos1 = InStr(pos1 + 1, strSearchText, strSearchFor) + Len(strSearchFor)
    Do While pos1 > 0
        ReDim Preserve strSearchTextFound(foundText)
        strSearchTextFound(foundText) = Mid(strSearchText, pos1, InStr(pos1, strSearchText, strSeperator) - pos1)
       
        pos1 = InStr(pos1 + 1, strSearchText, strSearchFor)
        If pos1 > 0 Then pos1 = pos1 + Len(strSearchFor)
        foundText = foundText + 1
    Loop
    CadenasEntreCaracteres = strSearchTextFound
   
End Function
0
 
irudykCommented:
CadenasEntreCaracteres is a user defined function, as is indicated by the declaration
    Public Function CadenasEntreCaracteres(strSearchText As String, _
    strSearchFor As String, strSeperator As String) As String()
As such you could change this function name from CadenasEntreCaracteres to say ParseDataCharacters or whatever else you want to call it.  Whatever you change it to though would have to be altered throughout the rest of the code otherwise you will get an error.  Do a find and replace on your code to ensure you replace each occurrence.
As for what this function does, if finds the text passed to the strSearchFor variable that exists within the enitre text you want searched as passed to the strSearchText variable.  The foundText tracks the number of matches found and the pos1 tracks the last position within the strSearchText that the strSearchFor was found.  The strSearchTextFound is an array that stores the information you wan't place in the spreadsheet.  This array information is passed back to the function name (which itself is defined as an array...i.e. the As String() portion of the Functions declaration).
0
 
j8547Author Commented:
Thanks so much fo all your help. Really appreciated
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Tackle projects and never again get stuck behind a technical roadblock.
Join Now