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



一切正常,直到我到达ActiveWorkbook.SaveAs行,在那里我得到一个运行时错误1004。

`子测试程序((

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错误。有什么想法吗?

显示基本原理:

编辑:对代码进行一些更改。。。

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

最新更新