Question

一切正常，直到我到达ActiveWorkbook.SaveAs行，并在其中收到运行时错误1004。

`Sub Tester（）

Dim qNum, fldr As String
Dim custName As String
Dim myFileName As String
Dim completePath As String
Dim division As String

custName = Range("B12").Value
qNum = Range("B19").Value

If custName = "CNUL - Albian" Then
    custName = "CNRL"
    division = "Albian"
End If
If custName = "CNUL - Horizon" Then
    custName = "CNRL"
    division = "Horizon"
End If
If custName = "CNRL - Albian" Then
    custName = "CNRL"
    division = "Albian"
End If
If custName = "CNRL - Horizon" Then
    custName = "CNRL"
    division = "Horizon"
End If

If custName = "CNRL" Then
    fldr = GetMatchingPathCNRL(qNum, custName, division) '<< find the        matching folder
    If Len(fldr) > 0 Then
        Debug.Print "Found folder for customer=" & custName & _
                        ", Qnum=" & qNum & vbLf & fldr
            '...use this path

    Else
        MsgBox "No matching folder!", vbExclamation
    End If
Else
    fldr = GetMatchingPath(qNum, custName) '<< find the matching folder
    If Len(fldr) > 0 Then
        Debug.Print "Found folder for customer=" & custName & _
                    ", Qnum=" & qNum & vbLf & fldr
        '...use this path

    Else
        MsgBox "No matching folder!", vbExclamation
    End If
End If


myFileName = custName & " " & qNum & " " & "MTO Rev A"
completePath = fldr & "\" & myFileName

ActiveWorkbook.SaveAs Filename:=completePath
End Sub

Function GetMatchingPath(qNum, custName) As String
Const ROOT As String = "P:\MyCompany\" '<< adjust to suit
Dim f
f = Dir(ROOT & custName & "\*" & qNum & "*", vbDirectory)
GetMatchingPath = ROOT & custName & "\" & f
End Function


Function GetMatchingPathCNRL(qNum, custName, division) As String
Const ROOT As String = "P:\MyCompany\" '<< adjust to suit
Dim f
f = Dir(ROOT & custName & "\" & division & "\*" & qNum & "*", vbDirectory)
GetMatchingPathCNRL = ROOT & custName & "\" & f
End Function

` 它可以正确找到文件路径，看起来应该在正确的位置完成保存，但是我总是遇到1004错误。有什么想法吗？

Answer 1

展示基本原理：

编辑：对您的代码进行了一些更改...

Sub Tester()

    Dim qNum, fldr
    Dim custName

    custName = Range("B12").Value
    qNum = Range("B19").Value

    fldr = GetMatchingPath(qNum, custName) '<< find the matching folder
    If Len(fldr) > 0 Then

        Debug.Print "Found folder for customer=" & custName & _
                    ", Qnum=" & qNum & vblf & fldr
        '...use this path

    Else
        MsgBox "No matching folder!", vbExclamation
    End If

End Sub

'get the path for a given q number
Function GetMatchingPath(qNum, custName) As String
    Const ROOT As String = "P:\Weir\" '<< adjust to suit
    Dim f

    f = Dir(ROOT & custName & "\" & qNum & "*", vbDirectory)
    GetMatchingPath = ROOT & custName & "\" & f
End Function

VBA-保存文件-部分基于单元格值确定文件路径

1 个答案: