0

I am not familiar with VBA so please forgive the simplicity of this question. I have a recorded macro which selects, opens then saves a file from a hyperlink in one of my columns. I just want to make a loop to repeat this macro down all of the rows in the worksheet which have data in them. Below is the code for the recorded macro, thank you all for your assistance.

Sub Extract()
'
'Extract Macro
'

'
Range("D2").Select
Selection.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
Workbooks.Open Filename:= _
    "https://channele.corp.etradegrp.com/communities/teams02/performance-monitoring/TPEF%20Library/A2Consulting_Tech_5650_VSAF.xlsm"
ActiveWindow.Visible = False
Windows("A2Consulting_Tech_5650_VSAF.xlsm").Visible = True
ChDir "O:\Procurement Planning\QA"
ActiveWorkbook.SaveAs Filename:= _
    "O:\Procurement Planning\QA\Copy of A2Consulting_Tech_5650_VSAF.xlsm", _
    FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
ActiveWindow.Close
End Sub 
Alex Dowd
  • 39
  • 9
  • A [Do...Loop](https://learn.microsoft.com/it-it/dotnet/visual-basic/language-reference/statements/do-loop-statement) cycle is what you are looking for. Use the `Until` to make it go until the given cell is empty. I'd also raccomend not to select the given cell; instead you should declear a variable and then refers to it. – Evil Blue Monkey Oct 02 '20 at 15:05
  • A loop is just the start of the work to be done. You have several different steps in your macro which have hard-coded names: all of these need to change when you have a new filename. You also need to extract the filename as the part after the last '/' in your hyperlink, and re-use that with your new directory. Perhaps have a go, and then come back here with your attempt, then other users may help you correct specific problems. – DS_London Oct 02 '20 at 15:19

1 Answers1

0

Something like this might work already:

Sub Extract()
    
    Dim RngTarget As Range
    Dim StrFileName As String
    
    Set RngTarget = Range("D2")
    
    Do Until RngTarget.Value = ""
        
        RngTarget.Hyperlinks(1).Follow NewWindow:=False, AddHistory:=True
        Workbooks.Open Filename:=RngTarget.Value
        StrFileName = Split(RngTarget.Value, "/")(UBound(Split(RngTarget.Value, "/")))
        Windows(StrFileName).Visible = True
        Workbooks(StrFileName).SaveAs Filename:="O:\Procurement Planning\QA\Copy of " & Split(StrFileName, ".")(0) & ".xlsm", _
                                      FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
                                      CreateBackup:=False
        Workbooks(StrFileName).Close
        
        Set RngTarget = RngTarget.Offset(1, 0)
    Loop
    
End Sub
Evil Blue Monkey
  • 2,276
  • 1
  • 7
  • 11
  • Sorry this didn't work. It keeps iterating over the same cell it doesn't move on. Also, and I'm not sure if anything can be done about this, a user has to remain to confirm files being opened/saved (even though the macro recorded these actions). There are over 500 of these records and I am trying to automate this. – Alex Dowd Oct 02 '20 at 15:17
  • Yeah, sorry. I forgot to add the `Set RngTarget = RngTarget.Offset(1, 0)` line before publishing. Now i've added it but i realize that your code use strings to open and save the link. I have to modify it a little so it picks the value of the cell targeted. I guess that in each cell is a full link like that "https://channele.corp.etradegrp.com/communities/teams02/performance-monitoring/TPEF%20Library/A2Consulting_Tech_5650_VSAF.xlsm", right? – Evil Blue Monkey Oct 02 '20 at 15:22
  • Or [find the last row](https://stackoverflow.com/questions/11169445/error-in-finding-last-used-cell-in-excel-with-vba) and use `For i = 2 to lastRow` in a regular `For` loop. – BigBen Oct 02 '20 at 15:35