Question

好的，下面是一个代码，它根据可见的单元格范围从一个位置获取pdfs，然后将它们放在一个创建的目录中，然后调用另一个模块来合并pdfs。在第二个模块中有一个变量strPath，当定义完整文件夹路径时，它可以正常工作。然而，尝试使用像＆＃34; .. \ Submittal Packaged \ BOM PDF \＆＃34;它在一个循环中陷入困境。我已经调试并观察它一步一步找到文件夹中的每个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

Answer 1

将默认目录分配给Y：与第一个模块中的CX509CertificateRequestCmc一样

Answer 2

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

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

这里概述了如何在VBA中使用FileSystemObject： http://www.exceltrick.com/formulas_macros/filesystemobject-in-vba/

Excel宏陷入while循环

2 个答案: