Macro creates links for all files in folder. How can I customize where to place the links?

**JPWRana** · 05-20-2013, 03:09 PM

I have a macro that creates a link for every file (specifically those files are only pictures-jpeg), and sets those links in Column A. If I have 110 jpegs in that folder, it will create 110 links all on Row A.

Those pictures have a specific naming system where... depending on what they are called, they belong to a specific column and row. There are about 45 different widgets, and each widget is named by numbers, and each widget has 2 pictures (for the most part) one ending in "est" and one ending in "id".

One column has the "est" pictures, and the other has the "id" pictures. The first 45-48 rows are for the corresponding widget number. How can I change the vba coding so that... when the link is created, it NOT ONLY puts the links that end in "est" and "id" in the correct columns, but also the right widget number in the right row?

I have uploaded the file so you guys can see...

1) Where the macro places the links (in row A)
2) Where those links are SUPPOSED TO BE in columns K & L, and the corresponding rows in column C.

Any help would be greatly appreciated.
Thanks

**protonLeah** · 05-20-2013, 08:50 PM

An untested idea:

Sub Create_Hyperlinks()
    
    Dim fs, fol, fil, count, _
        WidgetType As String, _
        WidgetNum  As String
    
    Set fs = CreateObject("Scripting.filesystemobject")
    Set fol = fs.getfolder("\\abcdefg.com\workgroup\TDBU26\E&TS DR\Working\Quality\Inspections\M&I_Inspections\Photos_ODI\05 May\David Butler\") 'Change This
    For Each fil In fol.Files
        WidgetType = LCase(Mid(fil.Name, Len(fil.Name) - 6, 3))
        WidgetNum = Left(fil.Name, 8)
        
        
        Select Case WidgetType
            Case Is = "id"
                ActiveSheet.Hyperlinks.Add _
                    Anchor:=Range(Cells(Rows.count, "K").End(xlUp).Offset(1, 0).Address), _
                    Address:=fil.Path, _
                    TextToDisplay:=fil.Name
            Case Is = "est"
                ActiveSheet.Hyperlinks.Add _
                    Anchor:=Range(Cells(Rows.count, "L").End(xlUp).Offset(1, 0).Address), _
                    Address:=fil.Path, _
                    TextToDisplay:=fil.Name
        End Select  'WidgetType
        
        Cells(Rows.count, "C").End(xlUp).Offset(1, 0).Value = WidgetNum
        
    Next fil
End Sub

**JPWRana** · 05-21-2013, 10:46 PM

proton, almost there. It worked for row L, the "est" links, with a minor glitch. For most of the widgets, it linked to the right cell... but then again, for most of the widgets there are links to them.
Widget #11 for example, does not have a link, so the macro should have skipped that row and continued applying the links to Widget #12 and going on, since those DO HAVE links.

Also, row K, the "id" links... I checked the coding... For some reason, for that one, it DID NOT WORK.
Perhaps since there are 2 cases under Select Case WidgetType, it only applied the macro to the one closer to the coding "End Select 'WidgetType?

Thanks again proton for your efforts.

**JPWRana** · 05-24-2013, 02:01 PM

I altered the "Case Is" part so many times and I can't get the "id" links to pop up at all, let alone in the right part.

I wonder why it would work for the est links, but not the id links?

**JPWRana** · 05-24-2013, 01:59 PM

I attempted to change the case placements for "id" and "est" but again, only the est links would work. When I would remove the case for "est" all together and replaced the only case left, the "id" case, it still wouldn't work.

Any idea why the "est" case would work but not the "id" case?

**protonLeah** · 05-30-2013, 04:00 PM

I'm sorry for the delay, but I was away for a while. I have posted another try. One macro, GetFileNames creates a new sheet and reads the folder list into that sheet, sorts the list and determines if there are both id and est file names for each drawing. The second macro fans the list into the correct columns. It seems to work with the small test file I created.

Sub GetFileNames()
    'add a JPG List sheet
    'read the file names into column A
    'sort the list, ascending
    'insert a formula into column B to indicate
    'if the structure numbers are the same

    Dim fs, fol, fil, FileCount, _
        JPGList As Worksheet
    FileCount = 1
    
    Set fs = CreateObject("Scripting.filesystemobject")
    Set fol = fs.getfolder("\\abcdefg.com\workgroup\TDBU26\E&TS DR\Working\Quality\Inspections\M&I_Inspections\Photos_ODI\05 May\David Butler\") 'Change This

    ThisWorkbook.Worksheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "jpg list"
    Set JPGList = Sheets("jpg list")

    For Each fil In fol.Files
        JPGList.Range("A" & FileCount).Value = fil.Name
        JPGList.Range("B" & FileCount).Value = fil.Path
        FileCount = FileCount + 1
    Next fil
    FileCount = FileCount - 1
    
    With JPGList
        .Sort.SortFields.Clear
        .Sort.SortFields.Add _
            Key:=Range("A1"), _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            DataOption:=xlSortTextAsNumbers
    End With
        
    With JPGList.Sort
        .SetRange Range("A1:A" & FileCount)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    JPGList.Range("B1").Formula = "=LEFT(A1,9)=LEFT(A2,9)"
    Range("B1").Select
    Selection.AutoFill _
        Destination:=JPGList.Range("B1:B" & FileCount)
    JPGList.Range("D1").Value = FileCount
End Sub

Sub Create_Hyperlinks()
    
    Dim JPGList     As Worksheet, _
        DESTSHT     As Worksheet, _
        NameList    As Range, _
        TestName    As Range, _
        AnchorCell  As Range, _
        Structure   As String, _
        ESTName     As String, _
        IDName      As String, _
        ESTandID    As Boolean, _
        Ctrl        As Long, _
        RevNum      As Long, _
        RevRow      As Long, _
        RevCols     As Variant
        
    RevCols = Array("", "M", "O", "Q", "S")
    
    Call GetFileNames
    
    Set JPGList = Sheets("jpg list")
    Set DESTSHT = Sheets("CheckSheet")
    
    FileCount = JPGList.Range("D1").Value
    Set NameList = JPGList.Range("A1:A" & FileCount)

    For Ctrl = 1 To FileCount
        Structure = Left(JPGList.Cells(Ctrl, "A").Value, 8)
        ESTandID = JPGList.Cells(Ctrl, "C").Value
        Set AnchorCell = Nothing
        ESTName = ""
        IDName = ""
        
        Select Case ESTandID
            Case Is = True
                Set AnchorCell = DESTSHT.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
                AnchorCell.Value = Structure
                RevRow = AnchorCell.Row
                ESTName = Left(JPGList.Cells(Ctrl, "A").Value, Len(JPGList.Cells(Ctrl, "A").Value) - 4)
                IDName = Left(JPGList.Cells(Ctrl + 1, "A").Value, Len(JPGList.Cells(Ctrl + 1, "A").Value) - 4)
                With DESTSHT
                    .Hyperlinks.Add _
                        Anchor:=AnchorCell.Offset(0, 8), _
                        Address:=JPGList.Cells(Ctrl + 1, "B").Value, _
                        TextToDisplay:=IDName
                        
                    .Hyperlinks.Add _
                        Anchor:=AnchorCell.Offset(0, 9), _
                        Address:=JPGList.Cells(Ctrl, "B").Value, _
                        TextToDisplay:=ESTName

                End With
                Ctrl = Ctrl + 1
            Case Is = False
                If InStr(JPGList.Cells(Ctrl, "A").Value, "est") > 0 Then
                    Set AnchorCell = DESTSHT.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
                    AnchorCell.Value = Structure
                    RevRow = AnchorCell.Row
                    ESTName = Left(JPGList.Cells(Ctrl, "A").Value, Len(JPGList.Cells(Ctrl, "A").Value) - 4)
                    DESTSHT.Hyperlinks.Add _
                        Anchor:=AnchorCell.Offset(0, 9), _
                        Address:=JPGList.Cells(Ctrl + 1, "B").Value, _
                        TextToDisplay:=ESTName
                
                ElseIf InStr(JPGList.Cells(Ctrl, "A").Value, "id") > 0 Then
                    Set AnchorCell = DESTSHT.Cells(Rows.Count, "J").End(xlUp).Offset(1, 0)
                    AnchorCell.Value = Structure
                    IDName = Left(JPGList.Cells(Ctrl + 1, "A").Value, Len(JPGList.Cells(Ctrl + 1, "A").Value) - 4)
                    RevRow = AnchorCell.Row
                    DESTSHT.Hyperlinks.Add _
                        Anchor:=AnchorCell.Offset(0, 8), _
                        Address:=JPGList.Cells(Ctrl + 1, "B").Value, _
                        TextToDisplay:=IDName
                ElseIf JPGList.Cells(Ctrl, "A").Value Like "*(#)*" Then
                    RevNum = Left(Right(JPGList.Cells(Ctrl, "A").Value, 6), 1)
                    DESTSHT.Hyperlinks.Add _
                        Anchor:=DESTSHT.Cells(RevRow, RevCols(RevNum)), _
                        Address:=JPGList.Cells(Ctrl + 1, "B").Value, _
                        TextToDisplay:=Replace(UCase(JPGList.Cells(Ctrl, "A").Value), ".JPG", "")
                End If
        End Select
    Next Ctrl
    Application.DisplayAlerts = False
    JPGList.Delete
    Application.DisplayAlerts = True
End Sub

**JPWRana** · 05-31-2013, 01:50 AM

By the way, can't 2 macro's be merged into 1 macro? Or would the coding be too long/exhaustive for what I'm asking?

**JPWRana** · 05-31-2013, 01:49 AM

Proton, no worries about the delay. THANK YOU very much for your efforts.
I took a look at the sheet. I'm trying to understand some of your instructions.
The Checksheet(2) that you provided looks like in your test scenario things are working.

I'm still trying to get it to work, so stay tuned.

**protonLeah** · 06-01-2013, 08:44 PM

In order to merge the two macros, in the macro Create_Hyperlinks the line:

Call GetFileNames

can be deleted and the macro GetFileNames pasted in at that point. Though you don't need to do that since running the macro Create_Hyperlinks executes GetFileNames automatically. I used two macros to make testing and modifying easier.

Sub Create_Hyperlinks()
    
    Dim JPGList     As Worksheet, _
        DESTSHT     As Worksheet, _
        NameList    As Range, _
        TestName    As Range, _
        AnchorCell  As Range, _
        Structure   As String, _
        ESTName     As String, _
        IDName      As String, _
        ESTandID    As Boolean, _
        Ctrl        As Long, _
        RevNum      As Long, _
        RevRow      As Long, _
        RevCols     As Variant
        
    
    'Call GetFileNames      '   delete this line 
'---------------------------------------------------------------
    Dim fs, fol, fil, FileCount
    FileCount = 1
    
    Set fs = CreateObject("Scripting.filesystemobject")
    Set fol = fs.getfolder("\\abcdefg.com\workgroup\TDBU26\E&TS DR\Working\Quality\Inspections\M&I_Inspections\Photos_ODI\05 May\David Butler\") 'Change This

    ThisWorkbook.Worksheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "jpg list"
    Set JPGList = Sheets("jpg list")

    For Each fil In fol.Files
        JPGList.Range("A" & FileCount).Value = fil.Name
        JPGList.Range("B" & FileCount).Value = fil.Path
        FileCount = FileCount + 1
    Next fil
    FileCount = FileCount - 1
    
    With JPGList
        .Sort.SortFields.Clear
        .Sort.SortFields.Add _
            Key:=Range("A1"), _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            DataOption:=xlSortTextAsNumbers
    End With
        
    With JPGList.Sort
        .SetRange Range("A1:A" & FileCount)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    JPGList.Range("C1").Formula = "=LEFT(A1,9)=LEFT(A2,9)"
    Range("C1").Select
    Selection.AutoFill _
        Destination:=JPGList.Range("C1:C" & FileCount)
    'JPGList.Range("D1").Value = FileCount
'---------------------------------------------------------------
    RevCols = Array("", "M", "O", "Q", "S")
    
    Set JPGList = Sheets("jpg list")
    Set DESTSHT = Sheets("CheckSheet")
    
    'FileCount = JPGList.Range("D1").Value
    Set NameList = JPGList.Range("A1:A" & FileCount)

    For Ctrl = 1 To FileCount
        Structure = Left(JPGList.Cells(Ctrl, "A").Value, 8)
        ESTandID = JPGList.Cells(Ctrl, "C").Value
        Set AnchorCell = Nothing
        ESTName = ""
        IDName = ""
        
        Select Case ESTandID
            Case Is = True  'both est and id names are present in the list
                Set AnchorCell = DESTSHT.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
                AnchorCell.Value = Structure
                RevRow = AnchorCell.Row
                ESTName = Left(JPGList.Cells(Ctrl, "A").Value, Len(JPGList.Cells(Ctrl, "A").Value) - 4)
                IDName = Left(JPGList.Cells(Ctrl + 1, "A").Value, Len(JPGList.Cells(Ctrl + 1, "A").Value) - 4)
                With DESTSHT
                    .Hyperlinks.Add _
                        Anchor:=AnchorCell.Offset(0, 8), _
                        Address:=JPGList.Cells(Ctrl + 1, "B").Value, _
                        TextToDisplay:=IDName
                        
                    .Hyperlinks.Add _
                        Anchor:=AnchorCell.Offset(0, 9), _
                        Address:=JPGList.Cells(Ctrl, "B").Value, _
                        TextToDisplay:=ESTName
                End With
                Ctrl = Ctrl + 1
            Case Is = False     'either est or or id or both are missing
                ' est is present not id
                If InStr(JPGList.Cells(Ctrl, "A").Value, "est") > 0 Then
                    Set AnchorCell = DESTSHT.Cells(Rows.Count, "B").End(xlUp).Offset(1, 0)
                    AnchorCell.Value = Structure
                    RevRow = AnchorCell.Row
                    ESTName = Left(JPGList.Cells(Ctrl, "A").Value, Len(JPGList.Cells(Ctrl, "A").Value) - 4)
                    
                    DESTSHT.Hyperlinks.Add _
                        Anchor:=AnchorCell.Offset(0, 9), _
                        Address:=JPGList.Cells(Ctrl + 1, "B").Value, _
                        TextToDisplay:=ESTName
                        
                'id is present not est
                ElseIf InStr(JPGList.Cells(Ctrl, "A").Value, "id") > 0 Then
                    Set AnchorCell = DESTSHT.Cells(Rows.Count, "J").End(xlUp).Offset(1, 0)
                    AnchorCell.Value = Structure
                    IDName = Left(JPGList.Cells(Ctrl + 1, "A").Value, Len(JPGList.Cells(Ctrl + 1, "A").Value) - 4)
                    RevRow = AnchorCell.Row
                    
                    DESTSHT.Hyperlinks.Add _
                        Anchor:=AnchorCell.Offset(0, 8), _
                        Address:=JPGList.Cells(Ctrl + 1, "B").Value, _
                        TextToDisplay:=IDName
                        
                'neither est nor id is present, so check for a single digit in parentheses
                'indicating a revision # present
                
                ElseIf JPGList.Cells(Ctrl, "A").Value Like "*(#)*" Then
                
                    ' get the revision number as pointer to the destination column
                    
                    RevNum = Left(Right(JPGList.Cells(Ctrl, "A").Value, 6), 1)
                    
                    DESTSHT.Hyperlinks.Add _
                        Anchor:=DESTSHT.Cells(RevRow, RevCols(RevNum)), _
                        Address:=JPGList.Cells(Ctrl + 1, "B").Value, _
                        TextToDisplay:=Replace(UCase(JPGList.Cells(Ctrl, "A").Value), ".JPG", "")
                End If
        End Select
    Next Ctrl
    Application.DisplayAlerts = False
    JPGList.Delete
    Application.DisplayAlerts = True
End Sub

**JPWRana** · 06-03-2013, 12:08 PM

Proton, I have a question. Tab "Checksheet" has in Column A the list of file/picture links in the files we have uploaded. The file you uploaded Macro wording help(bvj).xlsm‎ has 2 tabs, "Checksheet" and "Checksheet(2)".

When I move my mouse icon to the links in column A of "Checksheet", they display the link path location. When I move my mouse icon to the links in "Checksheet(2)", the links display the link path location of where they are located relative to tab "Checksheet", not relative to the link path location. Was that done on purpose?

Also, when I run the "Create Hyperlinks" Macro, I keep on getting a Run-time error:

Invalid procedure call or argument at the following line:
"IDName = Left(JPGList.Cells(Ctrl + 1, "A").Value, Len(JPGList.Cells(Ctrl + 1, "A").Value) - 4)"

Any idea what that is for?
GetFileNames macro works as you coded it with no errors.
Create_Hyperlinks has the error on the line of coding listed above.

**protonLeah** · 06-05-2013, 01:01 AM

When I move my mouse icon to the links in column A of "Checksheet", they display the link path location. When I move my mouse icon to the links in "Checksheet(2)", the links display the link path location of where they are located relative to tab "Checksheet", not relative to the link path location. Was that done on purpose?

Sorry, that was part of my test data. Also, I can't replicate your error message; it runs on my machine.

**JPWRana** · 06-05-2013, 12:43 PM

In fixing the column issue, the links work, id & est shots go in their correct position, but now pictures (1), (2), (3), and (4) only go to the est and id columns.

Any word why that may happen?
When I had the run time error, the (#) pictures would go in their correct column, but not the right row.

**JPWRana** · 06-05-2013, 12:19 PM

Proton/Ben

I took a look at the coding to see what was causing the error... and I think it got me 1 step closer to my final goal.

The GetFileNames macro had in column B put BOTH the url address for the hyperlink AND the formula for "=LEFT(A1,9)=LEFT(A2,9)", so therefore, when the second macro would start up, it created weird issues.

I do see that the two merged macros that you give in your latest coding post fixes that to put the jpglist checksheet formula in column C instead of column B. I will test that out.

**protonLeah** · 06-05-2013, 10:38 PM

In the macro, replace the line:
JPGList.Range("C1").Formula = "=LEFT(A1,9)=LEFT(A2,9)"
with

JPGList.Range("B1").FormulaR1C1 = _
        "=AND(LEFT(RC[-2],9)=LEFT(R[1]C[-2],9),MID(R[1]C[-2],9,1)<>""("")"

It checks for a"(" indicating a revision number. I had that at first but lost it some how.

**JPWRana** · 06-05-2013, 11:58 PM

Proton, that line of coding gave me a runtime error. When I changed Range("B1") to Range("C1"), it worked a lot better. Now I am trying to see if I can migrate these macros to other VERY similar test cases.

These other test cases don't have the widgets be 8 characters long.
Also, do you know how I can change the path to where I get the files from under the "GetFileName" macro from what a cell has instead of manually renaming the link in the macro every time?

**JPWRana** · 06-06-2013, 02:53 PM

Would loading up the excel file on that example be better instead?

**JPWRana** · 06-06-2013, 02:52 PM

Proton, I tested it out for another scenario. The widgets were placed in the correct descending order regardless of digits, but because they had 1 less character, one of the links ommited the word "id" in it, and thus, the link doesn't work.

Any way to change some of that line of coding so that it bases the link on the right column based on the word "id" being there rather than the amount of characters?

Ex: The test case I gave you fortunately happened to have 8 characters (7 numbers, and 1 letter).
Another test case I studied the macro for has widgets that have both, 8 characters (7 #'s and 1 letter), and 7 characters (6 #'s and 1 letter). Also, the last letter ends in S. In some cases there are less #'s, and in others cases, there are 2 or 3 letters in the widget id.

**protonLeah** · 06-06-2013, 07:30 PM

Yes, please upload a new file. Be sure to include the macros you are currently using.

**JPWRana** · 06-10-2013, 11:50 AM

Ben, I found an issue with the linking part of the macro. When I made the coding change from post #14, the links now made their way to their proper cell AND with the right link name. Before I delve into what I found in post #16 (different widgets having different amount of character lengths in their name), the links that are currently created don't always necessarily go to the right file.

I did note that the links MOST of the time were one file off.

Ex 1: For the first third of the links, est shot & id picture links were in the right column, but then they switch the rest of the way down the template, where all photos that had "id" in the file name are now placed in the est column although the link name is correct.

Ex 2: Where there are finding pictures (123E(1), 123E(2), 123E(3), etc.), picture (1) will never link to 123E(1). Picture 123E(2) will always link to 123E(3), picture 123E(3) will always link to 123E(4), and 123E(4) will always link to 124E est

Is there a way to create the links BEFORE they get moved to their correct spots in the Checksheet tab?

Again, the coding change I made from your post in post #14 now makes the correct link names AND puts them in the right spots, but at the moment, they aren't linking to the right picture.

Sorry for the delayed post Ben.

**protonLeah** · 06-10-2013, 07:23 PM

Can you post your latest work?

**JPWRana** · 06-13-2013, 11:07 AM

Ben, here is the upload you requested.
I made a tab called "Notes" to show you which files are linking to what file name hyperlinks.

Most of the time, the hyperlink name is off by 1 file name, but the hyperlink names are correct and at the right location on the checksheet, they are just hyperlinking the wrong file.

**JPWRana** · 06-18-2013, 11:07 AM

Ben, have you had a chance to look at the file yet?

**JPWRana** · 07-12-2013, 06:48 PM

Proton, in your absence I was tinkering with the file template in a way that the links for (1), (2), (3), and (4) don't need to be in the right place anymore. This is due to the fact that their accuracy is better if done manually (it makes sense to me... big time).

Having that said, the hyperlinking would only need to be for the id and est shots. In your current macro, it ALSO puts the widget numbers on the left column (I don't need that. At the time of your absence it wasn't as necessary, but since you put it in there, I'm ok with it). Since only the "id" and "est" would be needed, could the macro state that if the widget numbers on the left of the spreadsheet don't have an id or est sheet, they skip to the next widget (like they CURRENTLY DO), AND if current links can't be placed somewhere then just have them moved to a new sheet for my re-work? That way I can find out why those links aren't where they are supposed to be. (Usually that is because I named them wrong and once I fix the file names and run the macro again, then it is supposed to put them in the right place).

**protonLeah** · 07-15-2013, 01:55 PM

Please check the attachment.

**JPWRana** · 07-16-2013, 05:09 PM

Proton, I took a look at the new test case you uploaded.

- File links *(1), *(2), *(3), and *(4) now don't create Links.
- The File link NAMES *(1), *(2), *(3), and *(4) gets placed on the Structure Column.
- The est and id links remain with the same issue as the last test case upload WITH the coding change from post #14.... the link NAMES are correct, but they open up a different link.

In your test case, the links appear correct until 1600229E. In that widget, since you have (#) links, the est and id links will not create, just like in your test case.

**JPWRana** · 07-16-2013, 06:10 PM

Proton, I was tinkering with my template, and with the new one that I have...

All I need is (rather than all the components needed to make the current macro work)

est shots and id shot links in the right location, with the right hyperlink name, AND linking to the right file

where I have multiple (#) files...

Ex 1: if I have 1 widget with (1), (2), (3), (4), (5), (6),
then in row, for the corresponding widget id, just to have a 6.

Ex 2: if I have a widget with (1), (2), then the widget row in column N will have a 2.

I don't need the macro to put in the list of all the different widget names in the Structure column, unless it is needed. Let me know what you think.

**protonLeah** · 07-20-2013, 07:49 AM

These seem to work now:

Sub GetFileNames()
    'add a JPG List sheet
    'read the file names into column A
    'sort the list, ascending
    'insert a formula into column B to indicate
    'if the structure numbers are the same

    Dim fs, fol, fil, Filecount, _
        JPGList As Worksheet
    Filecount = 1
    
    Set fs = CreateObject("Scripting.filesystemobject")
    Set fol = fs.getfolder("\\abcdefg.com\workgroup\TDBU26\E&TS DR\Working\Quality\Inspections\M&I_Inspections\Photos_ODI\05 May\David Butler\") 'Change This

    ThisWorkbook.Worksheets.Add after:=Sheets(Sheets.Count)
    ActiveSheet.Name = "jpg list"
    Set JPGList = Sheets("jpg list")

    For Each fil In fol.Files
        JPGList.Range("A" & Filecount).Value = fil.Name
        JPGList.Range("B" & Filecount).Value = fil.Path
        Filecount = Filecount + 1
    Next fil
    
    With JPGList
        .Sort.SortFields.Clear
        .Sort.SortFields.Add _
            Key:=Range("A1"), _
            SortOn:=xlSortOnValues, _
            Order:=xlAscending, _
            DataOption:=xlSortTextAsNumbers
    End With
        
    With JPGList.Sort
        .SetRange Range("A1:A" & Filecount)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Sub Create_Hyperlinks()
    Dim JPGList     As Worksheet, _
        DESTSHT     As Worksheet, _
        NameList    As Range, _
        TestName    As String, _
        StrucID     As Range, _
        RowPointer  As Long, _
        Filecount   As Long, _
        StrucLen    As Long
        
    'Call GetFileNames
    
    Set JPGList = Sheets("jpg list")
    Set DESTSHT = Sheets("13-6-PRATTDW")
    RowPointer = 5
    
    Filecount = JPGList.Range("A1").CurrentRegion.Rows.Count
    Set NameList = JPGList.Range("A1:A" & Filecount)
    
    StrucLen = InStr(JPGList.Range("A1").Value, " ") - 1
    TestName = Left(JPGList.Range("A1").Value, StrucLen)
    
    For Each StrucID In NameList
        If Left(StrucID, StrucLen) <> TestName Then
            RowPointer = RowPointer + 1
            StrucLen = InStr(StrucID.Value, " ") - 1
            TestName = Left(StrucID.Value, StrucLen)
        End If
        
        DESTSHT.Cells(RowPointer, 2).Value = TestName
        If InStr(StrucID, "est") > 0 Then
            With DESTSHT
                .Hyperlinks.Add _
                    Anchor:=DESTSHT.Cells(RowPointer, "M"), _
                    Address:=StrucID.Offset(0, 1).Value, _
                    TextToDisplay:=Replace(StrucID.Value, ".JPG", "")
            End With
        
        ElseIf InStr(StrucID, "id") > 0 Then
            With DESTSHT
                .Hyperlinks.Add _
                   Anchor:=DESTSHT.Cells(RowPointer, "L"), _
                   Address:=StrucID.Offset(0, 1).Value, _
                   TextToDisplay:=Replace(StrucID.Value, ".JPG", "")
            End With
                        
        ElseIf StrucID.Value Like "*(#)*" Then
            DESTSHT.Cells(RowPointer, "N").Value = DESTSHT.Cells(RowPointer, "N").Value + 1
        End If
    Next StrucID
End Sub

**JPWRana** · 07-20-2013, 01:11 PM

I replaced the macro coding you have in your latest upload and replaced it with the coding you have posted up.
After working out the location quirks and the tab name quirks, I get stuck at the following error message:

TestName = Left(JPGList.Range("A1").Value, StrucLen)

**JPWRana** · 07-20-2013, 01:16 PM

Proton, after replacing coding from what you have in your latest file update to what your latest coding post shows, it works MUCH better when...

1. I create a tab called jpg list (I thought the macro getfilenames does that automatically)
2. I first run the getfilenames macro, then I seperately run the createhyperlinks macro.

I did notice though that the hyperlinks were a little off as before. I took a look at the jpg list, and noticed the url paths were one cell off.

In the getfilenames tab, can you have both columns (the file name column, and the url address column) sort seperately so that they are in the same order and open up the correct link?

Once I ran the macros seperately, it hyperlinked MOST of the files. At some point, it gave the the error:

For Each StrucID In NameList
If Left(StrucID, StrucLen) <> TestName Then
RowPointer = RowPointer + 1
StrucLen = InStr(StrucID.Value, " ") - 1
TestName = Left(StrucID.Value, StrucLen) <---- This line of coding was highlighted as having an error.

**JPWRana** · 07-20-2013, 01:26 PM

Ben (or Proton, which do you prefer... I've been calling you both)

Once I sorted the 2 columns in the jpg list tab, it worked much better, but a few items linger...

1. The hyperlinking only goes down 45 rows. A few structures didn't get linked although there were no (#) links.
2. One of the structures has 12 (#) shots. Therefore, in the Findings Pictures, there was to be a 12. Instead, a 9 pops up.

Thanks again for your HUGE help with everything you've done.

**JPWRana** · 07-20-2013, 12:57 PM

Thanks Proton.

I seem to be getting an error in the Create Hyperlinks Macro in the following line:

TestName = Left(StrucID.Value, StrucLen)

From there it won't move on.
I can run the getfilenames macro just fine.

**protonLeah** · 07-20-2013, 03:06 PM

Can you post the current workbook you are testing with?
Note
The Create_Hyperlinks() does automatically run the GetFileNames but I commented out the line: Call GetFileNames because I can't read from your folders. I've been using the links from your original posting using a test sheet instead of reading a directory.

The line: For Each StrucID In NameList should process every file in the jpglist unless there is a blank line in the list for some reason. So I would like to see the current workbook you are using.

Ben

**JPWRana** · 07-23-2013, 01:14 AM

Ok. No problem. I just saw your message right now. I don't know why I didn't get an email notifiying me that there was a post reply on the thread.

Macro creates links for all files in folder. How can I customize where to place the links?

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

Macro creates links for all files in folder. How can I customize where to place the links?

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Re: Macro creates links for all files in folder. How can I customize where to place the li

Thread Information

Users Browsing this Thread

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions