Excel VBA 表单控件:打开/创建 Excel 文件

Question

我会使用 shipNo 和 FilePath 创建检查文件是否存在。如果没有，请复制主.xls并根据船号重命名文件。在所有情况下，之后打开文件。

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*DocumentsQueueRecord"
    SourceFile = "C:Users*DocumentsQueueRecordGen 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*DocumentsQueueRecord" + shipNo + ".xls")
End Sub

在我的测试中，SampleFileCopy.xls永远不会被创建，也不会创建textFile。

Answer 1

destFile 将始终以您编写的方式为空。我假设您希望该行如下所示：

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

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

这：

"C:Users*DocumentsQueueRecordGen master.xls"

应该是这样的：

Environ("userprofile") & "DocumentsQueueRecordGen master.xls"

此外，如注释中所述，删除"下次出错时恢复"，以便您知道代码在哪里中断。

下面的完整代码，基于destFile应该是filepath和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") & "DocumentsQueueRecord"
    SourceFile = Environ("userprofile") & "DocumentsQueueRecordGen 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") & "DocumentsQueueRecord" & shipNo & ".xls")
End Sub