Question

我将使用shipNo和FilePath创建检查文件是否存在的功能。如果不是，请复制master.xls并根据shipNo重命名该文件。在所有情况下，请稍后打开文件。

Private Sub PDFButton_Click()
    On Error Resume Next
    Dim SourceFile As String, destFile As String, sourceExtension, shipNo As String

    'Initialize variables
    shipNo = Range("D4").Value
    FilePath = "C:\Users\*\Documents\QueueRecord\"
    SourceFile = "C:\Users\*\Documents\QueueRecord\Gen master.xls\"

    If (destFile) = "" Then
        Dim fso, createText As FileSystemObject

        Set fso = New Scripting.FileSystemObject
        fso.CopyFile SourceFile, FilePath & "SampleFileCopy.xls\"
        Set createText = fso.CreateTextFile(FilePath, True, True)
        createText.Write "success"
        createText.Close

        If fso.FileExists(FilePath & "SampleFileCopy.xls\") Then
            MsgBox "Success"
        End If
    End If
    ActiveWorkbook.FollowHyperlink ("C:\Users\*\Documents\QueueRecord\" + shipNo + ".xls\")
End Sub

在我的测试中，从未创建SampleFileCopy.xls，也未创建textFile。

Answer 1

destFile将始终以您编写的方式为空。我假设您希望线看起来像这样：

If dir(FilePath & shipNo & ".xls") = "" Then

此外，请删除完整文件路径之后的所有反斜杠。

此：

"C:\Users\*\Documents\QueueRecord\Gen master.xls\"

应该是这样：

Environ("userprofile") & "\Documents\QueueRecord\Gen master.xls"

此外，如注释中所述，删除“下一步继续执行错误”，以便您知道代码在哪里中断。

下面的完整代码，基于假设destFile应该是文件路径和shipNo：

Private Sub PDFButton_Click()
    Dim SourceFile As String, destFile As String, sourceExtension, shipNo As String

    'Initialize variables
    shipNo = Range("D4").Value
    FilePath = Environ("userprofile") & "\Documents\QueueRecord\"
    SourceFile = Environ("userprofile") & "\Documents\QueueRecord\Gen master.xls"

    If Dir(FilePath & shipNo & ".xls", vbDirectory) = "" Then
        Dim fso As FileSystemObject

        Set fso = New Scripting.FileSystemObject
        fso.CopyFile SourceFile, FilePath & "SampleFileCopy.xls"

        'create text file
        TextFile = FreeFile
        Open FilePath & shipNo & ".txt" For Output As TextFile
        Print #TextFile, "success";
        Close TextFile

        If fso.FileExists(FilePath & "SampleFileCopy.xls") Then
            MsgBox "Success"
        End If
    End If
    ActiveWorkbook.FollowHyperlink (Environ("userprofile") & "\Documents\QueueRecord\" & shipNo & ".xls")
End Sub

Excel VBA Form控件：打开/创建Excel文件

1 个答案: