0

我正在尝试在 Excel VBE 中组合/嵌套 3 个不同的函数：打开、循环和单击。我把它们分开写了，但不确定如何组合它们。我尝试了“调用宏”功能，但收到了一个编译错误返回给我。

目标是打开某个文件夹中的一堆文件并单击所有文件中的 URL（URL 并不总是相同，因此我需要一个针对工作表中任何未知 URL 的单击函数）。

打开宏：

Sub openMyfile()

Dim Source As String
Dim StrFile As String

Source = "/users/kmogilevsky/Desktop/IC_new/"
StrFile = Dir("/users/kmogilevsky/Desktop/IC_new/")

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

循环宏：

 Sub LoopThroughFiles()
   Dim MyObj As Object, MySource As Object, file As Variant
   Set MySource = MyObj.GetFolder("/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
4

2 回答 2

0

此代码将打开桌面上 IC_New 文件夹中的所有 Excel 文件。
然后，它会查看每张工作表并跟踪工作表上的任何超链接。

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
于 2016-12-21T09:23:58.843 回答
0 
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

请编辑子程序 CollectData() 以使其适合您的需要，即执行点击/url 打开。（我不熟悉从 excel 打开网址，但我经常循环浏览工作簿）

于 2016-12-21T08:48:06.110 回答