Excel 宏卡在 while 循环中答案

【问题标题】：Excel Macro gets stuck in while loopExcel 宏卡在 while 循环中
【发布时间】：2016-04-06 01:35:52
【问题描述】：

好的，下面是一个代码，它根据可见的单元格范围从一个位置获取 pdf，然后将它们放在创建的目录中，然后调用另一个模块来合并 pdf。在第二个模块中，有一个变量 strPath，当定义完整文件夹路径时，它可以正常工作。但是，尝试使用“..\Submittal Packaged\BOM PDF\”之类的结构时，它会卡在一个while循环中。我已经调试并观察了它逐步完成并找到文件夹中的每个 pdf 文件，但它没有看到结尾，而是循环回到开头。

下面的代码是按照我遇到问题的方式配置的。

Option Explicit ' Force variable declaration
Public Const PDF_WILDCARD = "*.pdf"
Public Const JOIN_FILENAME = "MASTER BOM.pdf"
Public Sub CopyFile2()
    ChDrive "y:"
    ChDir ThisWorkbook.Path
    MkDir ("..\Submittal Packaged\BOM PDF\")
    Dim rng As Range
    Const strNewDir As String = "..\Submittal Packaged\BOM PDF\"

    For Each rng In Range("L9:L1042").SpecialCells(xlCellTypeVisible)
        If CBool(rng.Hyperlinks.Count) Then
            With rng.Hyperlinks(rng.Hyperlinks.Count)
                If CBool(InStr(.Address, Chr(92))) Then
                    If Dir(strNewDir & Replace(.Address, Chr(92), vbNullString, InStrRev(.Address, Chr(92)))) = "" Then
                        FileCopy .Address, _
                        strNewDir & Replace(.Address, Chr(92), vbNullString, InStrRev(.Address, Chr(92)))
                    Else
                        FileCopy .Address, _
                        strNewDir & rng.Row & "-" & Replace(.Address, Chr(92), vbNullString, InStrRev(.Address, Chr(92)))
                    End If
                Else
                    If Dir(strNewDir & .Address) = "" Then
                        FileCopy .Address, _
                        strNewDir & .Address
                    Else
                        FileCopy .Address, _
                        strNewDir & rng.Row & "-" & .Address
                    End If
                End If
            End With
        End If
    Next rng
Call mergepdf
End Sub

Sub mergepdf()
    Dim AcroExchApp As Object, AcroExchPDDoc As Object, _
        AcroExchInsertPDDoc As Object
    Dim strFileName As String, strPath As String
    Dim iNumberOfPagesToInsert As Integer, _
        iLastPage As Integer
    Set AcroExchApp = CreateObject("AcroExch.App")
    Set AcroExchPDDoc = CreateObject("AcroExch.PDDoc")


' Set the directory / folder to use
    strPath = "..\Submittal Packaged\BOM PDF\"

' Get the first pdf file in the directory
    strFileName = Dir(strPath + PDF_WILDCARD, vbNormal)

' Open the first file in the directory
    AcroExchPDDoc.Open strPath + strFileName

' Get the name of the next file in the directory [if any]
    If strFileName <> "" Then
        strFileName = Dir

    ' Start the loop.
        Do While strFileName <> ""

    ' Get the total pages less one for the last page num [zerobased]
            iLastPage = AcroExchPDDoc.GetNumPages - 1
            Set AcroExchInsertPDDoc = CreateObject("AcroExch.PDDoc")

        ' Open the file to insert
            AcroExchInsertPDDoc.Open strPath + strFileName

        ' Get the number of pages to insert
            iNumberOfPagesToInsert = AcroExchInsertPDDoc.GetNumPages

        ' Insert the pages
        AcroExchPDDoc.InsertPages iLastPage, AcroExchInsertPDDoc, 0, iNumberOfPagesToInsert, True

        ' Close the document
            AcroExchInsertPDDoc.Close

       ' Get the name of the next file in the directory
            strFileName = Dir
             Loop

    ' Save the entire document as the JOIN_FILENAME using SaveFull
[0x0001 = &H1]
        AcroExchPDDoc.Save &H1, strPath + JOIN_FILENAME

End If

' Close the PDDoc
    AcroExchPDDoc.Close

' Close Acrobat Exchange
    AcroExchApp.Exit
End Sub

【问题讨论】：

标签： vba excel while-loop macros

【解决方案1】：

将默认目录分配给 Y: 就像在第一个模块中一样 chdrive "y:\"

【讨论】：

即使按照上述建议进行操作后仍存在同样的问题

【解决方案2】：

我不记得所有的细节，但使用 DIR 目录列表可以根据其状态给出不同的答案。您可能想了解用于处理文件和文件夹的 FileSystemObject。

这是一个如何枚举文件夹及其子文件夹中所有文件的示例 https://stackoverflow.com/a/36365535/183298

以下是如何在 VBA 中使用 FileSystemObject 的概述： http://www.exceltrick.com/formulas_macros/filesystemobject-in-vba/

【讨论】：