We help IT Professionals succeed at work.

We've partnered with Certified Experts, Carl Webster and Richard Faulkner, to bring you two Citrix podcasts. Learn about 2020 trends and get answers to your biggest Citrix questions!Listen Now

x

VBA Word/String search

j8547
j8547 asked
on
Medium Priority
535 Views
Last Modified: 2013-11-25
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

Comment
Watch Question

Serge FournierAnalyst Programmer
CERTIFIED EXPERT

Commented:
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)
CERTIFIED EXPERT
Top Expert 2008

Commented:
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

Commented:
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

Author

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


CERTIFIED EXPERT
Top Expert 2008

Commented:
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

Author

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
CERTIFIED EXPERT
Top Expert 2008

Commented:
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

Author

Commented:
This works but how do i get rid of the character symbol at the end of each string. Thanks

Author

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
CERTIFIED EXPERT
Top Expert 2008

Commented:
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)?

Author

Commented:
Here is the log file.
Receive.log
CERTIFIED EXPERT
Top Expert 2008
Commented:
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

Not the solution you were looking for? Getting a personalized solution is easy.

Ask the Experts

Author

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
CERTIFIED EXPERT
Top Expert 2008

Commented:
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).

Author

Commented:
Thanks so much fo all your help. Really appreciated
Access more of Experts Exchange with a free account
Thanks for using Experts Exchange.

Create a free account to continue.

Limited access with a free account allows you to:

  • View three pieces of content (articles, solutions, posts, and videos)
  • Ask the experts questions (counted toward content limit)
  • Customize your dashboard and profile

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.