Kombinieren von Makros in Excel

Question

Ich versuche, 3 verschiedene Funktionen in Excel VBE zu kombinieren/verschachteln: öffnen, Schleife und klicken. Ich habe sie separat ausgeschrieben, bin mir aber nicht sicher, wie ich sie kombinieren soll. Ich habe die Funktion "Aufruf Makro" ausprobiert, bekam aber einen Kompilierfehler zurück.

Das Ziel ist, eine Reihe von Dateien in einem bestimmten Ordner zu öffnen und auf die URL in allen zu klicken (die URL wird nicht immer die gleiche sein, also brauche ich eine Klickfunktion, die auf eine unbekannte URL in einem Blatt zielt).

öffnen Makro:

Sub openMyfile() 

Dim Source As String 
Dim StrFile As String 

Source = "https://stackoverflow.com/users/kmogilevsky/Desktop/IC_new/" 
StrFile = Dir("https://stackoverflow.com/users/kmogilevsky/Desktop/IC_new/") 

Do While Len(StrFile) > 0 
    Workbooks.Open Filename:=Source & StrFile 
    StrFile = Dir("https://stackoverflow.com/users/kmogilevsky/Desktop/IC_new/") 
Loop 
End Sub 

Loop-Makro:

Sub LoopThroughFiles() 
    Dim MyObj As Object, MySource As Object, file As Variant 
    Set MySource = MyObj.GetFolder("https://stackoverflow.com/users/kmogilevsky/Desktop/IC_new/") 
    For Each file In MySource.Files 
     If InStr(file.Name, "test") > 0 Then 
      End If 
    Next file 
End Sub 


    Click macro (this needs some work): 

    Private Sub CommandButton1_Click() 
    Call NewSub 
    End Sub 

Answer 1

Sub ReadWorkbooksInCurrentFolder() 
    Dim wbDst As Workbook 
    Dim wbSrc As Workbook 
    Dim MyPath As String 
    Dim strFilename As String 

    'Stop annoying popups while macro is running 
    Application.DisplayAlerts = False 
    Application.EnableEvents = False 
    Application.ScreenUpdating = False 

    'When working with many open workbooks its good to explicitly reference all workbooks, makes sure your code works and easier to read, understand and remember which workbook is which. 
    Set wbDst = ThisWorkbook 

    srcSheetName = "Data" 
    dstSheetName = "Results" 

    'I want to loop through all .xlsx files in the folder 
    MyPath = ThisWorkbook.Path 
    strFilename = Dir(MyPath & "\*.xlsx", vbNormal) 

    If Len(strFilename) = 0 Then 
     MsgBox "No workbooks found ending in .xlsx in current folder" 
     Exit Sub 
    End If 

    Do Until strFilename = "" 

     Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename) 
     Call CollectData(wbDst, wbSrc, dstSheetName, srcSheetName) 
     wbSrc.Close 

     strFilename = Dir() 

    Loop 


    Application.DisplayAlerts = True 
    Application.EnableEvents = True 
    Application.ScreenUpdating = True 

End Sub 

Sub CollectData(ByRef wbDst as Workbook, ByRef wbSrc as Workbook, dstSheetName as String, srcSheetName as String) 

    'Copy cell A1 contents in source workbook to destination workbook cell A1 
    wbDst.Sheets(dstSheetName).Range("A1") = wbSrc.Sheets(srcSheetName).Range("A1") 

End Sub 

Bitte bearbeiten Sie das Unterprogramm CollectData(), so dass es Ihren Bedürfnissen entspricht, das heißt führt der Klick/url offen. (Ich bin nicht vertraut mit Öffnen von URLs von Excel, aber ich oft durch Arbeitsmappen)

Answer 2

Dieser Code wird alle Excel-Dateien im Ordner IC_New auf dem Desktop geöffnet.
Es wird dann jedes Blatt betrachten und alle Hyperlinks folgen, die auf dem Blatt sind.

Sub Open_ClickHyperlinks() 

    Dim sPath As String 
    Dim vFiles As Variant 
    Dim vFile As Variant 
    Dim wrkBk As Workbook 
    Dim wrkSht As Worksheet 
    Dim HLink As Hyperlink 

    sPath = CreateObject("WScript.Shell").SpecialFolders("Desktop") & Application.PathSeparator & _ 
     "IC_New" & Application.PathSeparator 

    'Return all files that have an extension starting with xls. 
    vFiles = EnumerateFiles(sPath, "xls*") 

    'Loop through each file. 
    For Each vFile In vFiles 
     'Open the file 
     Set wrkBk = Workbooks.Open(Filename:=vFile, UpdateLinks:=False) 
     With wrkBk 
      'Loop through each worksheet in the file. 
      For Each wrkSht In .Worksheets 
       'Loop through each hyperlink on the worksheet. 
       For Each HLink In wrkSht.Hyperlinks 
        HLink.Follow 
       Next HLink 
      Next wrkSht 
      .Close SaveChanges:=False 
     End With 
    Next vFile 

End Sub 

'Get all files in the specified folder, default to include all subfolders as well. 
Public Function EnumerateFiles(sDirectory As String, _ 
      Optional sFileSpec As String = "*", _ 
      Optional InclSubFolders As Boolean = True) As Variant 

    EnumerateFiles = Filter(Split(CreateObject("WScript.Shell").Exec _ 
     ("CMD /C DIR """ & sDirectory & "*." & sFileSpec & """ " & _ 
     IIf(InclSubFolders, "/S ", "") & "/B /A:-D").StdOut.ReadAll, vbCrLf), ".") 

End Function