Data Mining & Hyperlink Automation Macro Help

matrix01011

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

I

DaiMitnick

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
.NewSearch
.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.

megna73

Thanx for sharing
[url=http://www.seoindia.mobi]seo India[/url]