Ошибка времени выполнения VBA 76 - путь не найден в Excel - PullRequest
Новая
       116

Ошибка времени выполнения VBA 76 - путь не найден в Excel

0 голосов
/ 14 июля 2020

Помощь будет признательна, так как я новичок в макросах, и это меня озадачило. Кажется, это работало раньше, но я, похоже, сделал что-то, что мешает этому работать.

Я получаю сообщение об ошибке времени выполнения «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

1 Ответ

0 голосов
/ 14 июля 2020

Вероятно, ваша проблема в том, что некоторые из ваших подкаталогов не существуют. Насколько мне известно, 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
...