VBA 运行时错误 76 - 在 Excel 中找不到路径

Question

如果我是 Macros 的新手，我将不胜感激，这让我很困惑。它似乎以前工作过，但我似乎做了一些阻止它工作的事情。

我收到运行时错误“76”-MkDir folderPathWithName 上的以下路径未找到

我检查了FileYear、FileQuarter、FileMonth、CallType 和Branch，所有这些似乎都是正确的。对应的文件夹存在。

谢谢！

Option Explicit
Sub CopyFile()

Dim oFSO As Object
Dim SourceFile As String
Dim DestinationFolder As String
Dim startPath As String
Dim myName As String
Dim FileYear As String
Dim FileQuarter As String
Dim FileMonth As String
Dim CallType As String
Dim AggNum As String
Dim Dte As String
Dim Branch As String
Dim iNum As String
Dim wb As Workbook
Dim ssheet As Worksheet
Dim dsheet As Worksheet
Dim td As String
Dim s As String
Dim ir As String
Dim pSheet As Workbook
Dim RG As Range
Dim xScreenUpdating As Boolean

Dim sws As Worksheet
Dim dws As Worksheet
Dim a As String
Dim b As String
Dim c As String
Dim d As String
Dim e As String
Dim f As String
Dim g As String
Dim h As String
Dim i As String
Dim j As String
Dim k As String
Dim Q1 As String
Dim Q2 As String
Dim Q3 As String
Dim Q4 As String
Dim Q5 As String
Dim Q6 As String
Dim Q7 As String
Dim Q8 As String
Dim Q9 As String
Dim Q10 As String
Dim Q11 As String
Dim Q12 As String
Dim Q13 As String
Dim Q14 As String
Dim Q15 As String
Dim Q16 As String
Dim Q17 As String
Dim Q18 As String
Dim Q19 As String
Dim Q20 As String
Dim Q21 As String
Dim Q22 As String
Dim Q23 As String
Dim Q24 As String
Dim Q25 As String
Dim Q26 As String
Dim DDSetup As String
Dim DDComplete As String
        

Dim folderPathWithName As String
Dim fOPath As String

FileYear = Range("B26")
FileQuarter = Range("B27")
FileMonth = Range("B28")
CallType = Range("B7")
AggNum = Range("B6")
Dte = Range("B29")
Branch = Range("B2")

startPath = "N:\Business Assurance Team\3. CONTROLS ASSURANCE\Audits\Compliance\01. Arrears Review\" & FileYear & "\" & FileQuarter & "\" & FileMonth & "\" & CallType & "\" & Branch & "\"
myName = ActiveSheet.Range("B1").Text  ' Change as required to cell holding the folder title

' check if folder exists, if yes, end, if not, create
folderPathWithName = startPath & Application.PathSeparator & myName

If Dir(folderPathWithName, vbDirectory) = vbNullString Then
    MkDir folderPathWithName

End If


Set oFSO = CreateObject("Scripting.FileSystemObject")

SourceFile = "N:\Business Assurance Team\3. CONTROLS ASSURANCE\Audits\Compliance\01. Arrears Review\Matthew\01. Arrears UK Scorecard MV.xlsm"
DestinationFolder = "N:\Business Assurance Team\3. CONTROLS ASSURANCE\Audits\Compliance\01. Arrears Review\" & FileYear & "\" & FileQuarter & "\" & FileMonth & "\" & CallType & "\" & Branch & "\" & myName & "\"

oFSO.CopyFile Source:=SourceFile, Destination:=DestinationFolder & "\" & myName & " - " & Dte & " - " & AggNum & ".xlsm"

Set sws = Sheets("Workload")
a = sws.Range("B1").Value 'Agent Name
b = sws.Range("B2").Value 'Branch
c = sws.Range("B8").Value 'Date
d = sws.Range("B9").Value 'Call Start
e = sws.Range("B10").Value 'Call Duration
f = sws.Range("B4").Value 'Assessor
g = sws.Range("B6").Value 'Agreement Number
h = sws.Range("B5").Value 'ContactID
i = sws.Range("B13").Value 'Summary of Call
j = sws.Range("B17").Value 'What went well
k = sws.Range("B21").Value 'What went well
Q1 = sws.Range("G2").Value 'Question 1
Q2 = sws.Range("G3").Value 'Question 2
Q3 = sws.Range("G4").Value 'Question 3
Q4 = sws.Range("G5").Value 'Question 4
Q5 = sws.Range("G6").Value 'Question 5
Q6 = sws.Range("G7").Value 'Question 6
Q7 = sws.Range("G8").Value 'Question 7
Q8 = sws.Range("G9").Value 'Question 8
Q9 = sws.Range("G10").Value 'Question 9
Q10 = sws.Range("G11").Value 'Question 10
Q11 = sws.Range("G12").Value 'Question 11
Q12 = sws.Range("G13").Value 'Question 12
Q13 = sws.Range("G14").Value 'Question 13
Q14 = sws.Range("G15").Value 'Question 14
Q15 = sws.Range("G16").Value 'Question 15
Q16 = sws.Range("G17").Value 'Question 16
Q17 = sws.Range("G18").Value 'Question 17
Q18 = sws.Range("G19").Value 'Question 18
Q19 = sws.Range("G20").Value 'Question 19
Q20 = sws.Range("G21").Value 'Question 20
Q21 = sws.Range("G22").Value 'Question 21
Q22 = sws.Range("G23").Value 'Question 22
Q23 = sws.Range("G24").Value 'Question 23
Q24 = sws.Range("G25").Value 'Question 24
Q25 = sws.Range("G26").Value 'Question 25
Q26 = sws.Range("G27").Value 'Question 26
CallType = sws.Range("B7").Value 'Call Type
DDSetup = sws.Range("B11").Value 'Call Type
DDComplete = sws.Range("B12").Value 'Call Type


Set wb = Workbooks.Open("N:\Business Assurance Team\3. CONTROLS ASSURANCE\Audits\Compliance\01. Arrears Review\" & FileYear & "\" & FileQuarter & "\" & FileMonth & "\" & CallType & "\" & Branch & "\" & myName & "\" & myName & " - " & Dte & " - " & AggNum & ".xlsm")
Set dws = wb.Sheets("Observation Sheet")

dws.Range("C4").Value = a 'Agent Name
dws.Range("C5").Value = b 'Branch
dws.Range("E5").Value = c 'Date
dws.Range("F5").Value = d 'Call Start
dws.Range("G5").Value = e 'Call Duration
dws.Range("B8:C8").Value = f 'Assessor
dws.Range("E8:F8").Value = g 'Agreement Number
dws.Range("G8").Value = h 'ContactID
dws.Range("B53:G53").Value = i 'Summary of Call
dws.Range("B56:G56").Value = j 'What went well
dws.Range("B59:G59").Value = k 'What went well
dws.Range("I12").Value = Q1 'Question 1
dws.Range("I13").Value = Q2 'Question 2
dws.Range("I14").Value = Q3 'Question 3
dws.Range("I15").Value = Q4 'Question 4
dws.Range("I17").Value = Q5 'Question 5
dws.Range("I18").Value = Q6 'Question 6
dws.Range("I19").Value = Q7 'Question 7
dws.Range("I20").Value = Q8 'Question 8
dws.Range("I22").Value = Q9 'Question 9
dws.Range("I23").Value = Q10 'Question 10
dws.Range("I24").Value = Q11 'Question 11
dws.Range("I26").Value = Q12 'Question 12
dws.Range("I27").Value = Q13 'Question 13
dws.Range("I28").Value = Q14 'Question 14
dws.Range("I29").Value = Q15 'Question 15
dws.Range("I30").Value = Q16 'Question 16
dws.Range("I31").Value = Q17 'Question 17
dws.Range("I32").Value = Q18 'Question 18
dws.Range("I33").Value = Q19 'Question 19
dws.Range("I34").Value = Q20 'Question 20
dws.Range("I35").Value = Q21 'Question 21
dws.Range("I36").Value = Q22 'Question 22
dws.Range("I37").Value = Q23 'Question 23
dws.Range("I39").Value = Q24 'Question 24
dws.Range("I40").Value = Q25 'Question 25
dws.Range("I41").Value = Q26 'Question 26
dws.Range("H43").Value = CallType 'CallType
dws.Range("H44").Value = DDSetup 'DD Setup
dws.Range("H45").Value = DDComplete 'DD Complete

Workbooks("02. Arrears UK Tracker MV.XLSM").Close SaveChanges:=True

End Sub

Answer 1

您的问题可能是您的某些子目录不存在。据我所知，如果其中的子目录不存在，Mkdir 将不会创建整个路径。

mkdir(C:\Temp\Test1\Test2)
if "test1" doesn't exists it will not create Test1 and Test2, you'll get Path not found error.
if "test1" exists mkdir will make test2

要解决您的问题，您必须检查每个子目录，如果它们不存在则创建它们。

Private Sub MkSubDir(ByVal Path As String)

    Dim oPath() As String
    oPath = Split(Path, Application.PathSeparator)
    
    Dim oCurPath As String
    oCurPath = oPath(0)
    
    Dim oCounter As Long
    For oCounter = 1 To UBound(oPath)
        oCurPath = oCurPath & Application.PathSeparator & oPath(oCounter)
        If Dir(oCurPath, vbDirectory) = "" Then MkDir (oCurPath)
    Next
End Sub