Data Mining & Hyperlink Automation Macro Help

Fellow Forum Members,
I'm using Snagit 9 (a screen capture app) to automatically generate and feed PDF screen capture files every 30 minutes into each of the folders listed below. For one daily cycle I have a total of 1152 (48 x 24 currency pairs = 1152) new screen captures nested in the folders shown below:

C:Root4x rades2009 forward1 USD-CAD
C:Root4x rades2009 forward2 USD-JPY
C:Root4x rades2009 forward3 USD-CHF
C:Root4x rades2009 forward4 GBP-USD
C:Root4x rades2009 forward5 GBP-CAD
C:Root4x rades2009 forward6 GBP-CHF
C:Root4x rades2009 forward8 GBP-NZD
C:Root4x rades2009 forward9 CHF-JPY
C:Root4x rades2009 forward10 EUR-USD
C:Root4x rades2009 forward11 EUR-CAD
C:Root4x rades2009 forward12 EUR-GBP
C:Root4x rades2009 forward13 EUR-CHF
C:Root4x rades2009 forward14 EUR-JPY
C:Root4x rades2009 forward15 EUR-AUD
C:Root4x rades2009 forward17 AUD-NZD
C:Root4x rades2009 forward18 AUD-CAD
C:Root4x rades2009 forward19 AUD-USD
C:Root4x rades2009 forward20 AUD-CHF
C:Root4x rades2009 forward21 AUD-JPY
C:Root4x rades2009 forward22 NZD-JPY
C:Root4x rades2009 forward23 NZD-USD
C:Root4x rades2009 forward24 NZD-CHF

Attached is an Excel matrix I have setup to help me track all these screen captures. "ROW 1" lists all of the Currency pairs and "Column A" and "Column B" contain the date and time in military format.

When Snagit generates a screen capture it assigns an automatically generated filename in this format:

"USD-CAD 02-11-09 15 00.pdf " (prefix field / system date field / and 15 00 is military time field for 3:00 PM).



  • Hi matrix01011, the following code should work, just copy and paste it into your Visual Basic Editor (Alt + F11 to bring it up in Excel). You can change the code where necessary, if you add more folders, change the arrayFolders(22) to arrayFolders(23) or however many you add and add the folder name in the same fashion as those below it. Also it searches up until row 75 at the moment, if you want to increase/decrease that just change the line "If RowInt > 75" to whatever number you want. Any problems, let me know. Dai,

    Sub RunCodeOnAllPDFFiles()

    Dim arrayFolders(22) As String 'array to hold all folder names
    arrayFolders(1) = "C:Root4x rades2009 forward1 USD-CAD"
    arrayFolders(2) = "C:Root4x rades2009 forward2 USD-JPY"
    arrayFolders(3) = "C:Root4x rades2009 forward3 USD-CHF"
    arrayFolders(4) = "C:Root4x rades2009 forward4 GBP-USD"
    arrayFolders(5) = "C:Root4x rades2009 forward5 GBP-CAD"
    arrayFolders(6) = "C:Root4x rades2009 forward6 GBP-CHF"
    arrayFolders(7) = "C:Root4x rades2009 forward8 GBP-NZD"
    arrayFolders(8) = "C:Root4x rades2009 forward9 CHF-JPY"
    arrayFolders(9) = "C:Root4x rades2009 forward10 EUR-USD"
    arrayFolders(10) = "C:Root4x rades2009 forward11 EUR-CAD"
    arrayFolders(11) = "C:Root4x rades2009 forward12 EUR-GBP"
    arrayFolders(12) = "C:Root4x rades2009 forward13 EUR-CHF"
    arrayFolders(13) = "C:Root4x rades2009 forward14 EUR-JPY"
    arrayFolders(14) = "C:Root4x rades2009 forward15 EUR-AUD"
    arrayFolders(15) = "C:Root4x rades2009 forward17 AUD-NZD"
    arrayFolders(16) = "C:Root4x rades2009 forward18 AUD-CAD"
    arrayFolders(17) = "C:Root4x rades2009 forward19 AUD-USD"
    arrayFolders(18) = "C:Root4x rades2009 forward20 AUD-CHF"
    arrayFolders(19) = "C:Root4x rades2009 forward21 AUD-JPY"
    arrayFolders(20) = "C:Root4x rades2009 forward22 NZD-JPY"
    arrayFolders(21) = "C:Root4x rades2009 forward23 NZD-USD"
    arrayFolders(22) = "C:Root4x rades2009 forward24 NZD-CHF"

    Dim arrayInt As Integer 'number in array (which folder to search)
    Dim CurrPDF As String 'will hold name of PDFs in folder
    Dim lCount As Long 'number used for looping
    Dim ValFound As Boolean 'Whether PDF name is found in excel sheet
    Dim SrchEnded As Boolean 'Ends search when calue found or all sheet searched
    Dim RowInt As Integer 'row number, used when looping
    Dim ColInt As Integer 'column number, used when looping
    Dim txtDisp As String 'Text to display in cell (same as they currently are)
    Dim FullName As String 'Full path of file, for hyperlink
    Application.ScreenUpdating = False 'stops screen flashing about
    Application.DisplayAlerts = False 'stops alert boxes etc.
    Application.EnableEvents = False 'stops events, to stop it slowing down
    On Error Resume Next 'just carries on if it hits an error
    arrayInt = 1 'start in first folder

    Do 'begins loop

    With Application.FileSearch 'below looks for all PDFs in folder
    .LookIn = arrayFolders(arrayInt)
    .FileType = msoFileTypeAllFiles
    .Filename = "*.pdf"

    If .Execute > 0 Then 'If there are PDFs in folder

    For lCount = 1 To .FoundFiles.Count 'goes through each PDF
    CurrPDF = .FoundFiles(lCount) 'currpdf = full name of PDF (including path)
    CurrPDF = Right(CurrPDF, (Len(CurrPDF) - Len(arrayFolders(arrayInt)))) 'trims name down to not include path
    ColInt = 3 'start in column C
    RowInt = 2 'start at row 2

    Do 'begins sub-loop

    ValFound = False
    SrchEnded = False

    If Cells(RowInt, ColInt).Value = CurrPDF Then 'if name found, end sub-loop
    ValFound = True
    SrchEnded = True
    Else 'otherwise move to next row
    RowInt = RowInt + 1
    If RowInt > 75 Then 'if we have gone past row 75 (change this if needed), go to next column of names
    RowInt = 2
    ColInt = ColInt + 2
    End If
    End If

    If ColInt > 27 Then 'if we have gone past column AA, end the search
    SrchEnded = True
    End If

    Loop Until SrchEnded = True 'loops until it is told the search has ended

    If ValFound = True Then 'if a value was found during search...
    txtDisp = Cells(RowInt, ColInt).Value 'text to display will be same as current text
    FullName = arrayFolders(arrayInt) & CurrPDF 'full path of PDF
    Cells(RowInt, ColInt).Select 'select the cell and add hyperlink to it:
    Selection.Hyperlinks.Add Anchor:=Selection, Address:=FullName, TextToDisplay:=txtDisp
    End If

    Next lCount 'go to next PDF in folder

    End If

    End With

    arrayInt = arrayInt + 1 'go to next value in array (next folder)

    Loop Until arrayInt > arrayFolders.Count 'stop loop once been through all folders in array

    Application.ScreenUpdating = True 'put screen back to normal
    Application.DisplayAlerts = True 'put screen back to normal
    Application.EnableEvents = True 'put screen back to normal

    End Sub

    Do or do not, there is no try.
  • Thanx for sharing
    [url=]seo India[/url]
Sign In or Register to comment.

Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!