Макрос должен извлекать данные из файлов Docx в определенной папке. Если какая-либо из этих папок открыта при запуске макроса, программа выдает ошибку 5792, и когда я проверяю имя файла, имя файла изменяется частично. Почему он это делает и как я могу программировать вокруг него.
Имя файла: C: \ Users \ Ashley \ Desktop \ Victim Complaints \ Victim Complaint Form.docx
Когда docxоткрыт и макрос запущен, имя файла меняется на это, и я получаю сообщение об ошибке: C: \ Users \ Ashley.Martin \ Desktop \ Victim Complaints \ ~ $ ctim Complaint Form.docx
Программа появляетсячтобы запустить реальные файлы, которые там есть, но тогда он запустит дополнительный файл с поврежденным именем файла.
Option Explicit
Dim FSO As Object
Dim myFile As Object
Dim myFolder As Object
Dim file As Object
Dim intRow As Integer
Dim docVic As Worksheet
Dim i As Integer
Dim strSumDoc As String
Dim LastSave As Date
Dim SumLastSave As Date
Dim docWord As Object
Dim appWord As Object
Dim FilePath As Variant
Dim HeadRange As Range
Sub VictimComplaints()
Set FSO = CreateObject("Scripting.FileSystemObject")
Set myFolder = FSO.getfolder(ThisWorkbook.Path)
Set docVic = ThisWorkbook.Worksheets("Sheet1")
Set appWord = CreateObject("Word.Application.16")
Set HeadRange = ThisWorkbook.Worksheets("Sheet1").Range("A2:AT2")
appWord.Visible = False
iCol = 1
'loops through filepaths in folder
For Each myFile In myFolder.Files
LastSave = FileDateTime(myFile)
If Right(myFile, 5) = ".docx" Then
intRow = docVic.Cells(docVic.Rows.Count, "B").End(xlUp).Row + 1
i = 3
Do While i <= intRow
strSumDoc = Cells(i, "B")
SumLastSave = Cells(i, "C")
'info on summary doc is already the latest bit of information
If strSumDoc = myFile And LastSave <= SumLastSave Then
Exit Do
'matching file already on document and saved later than last save date so info gets updated
ElseIf strSumDoc = myFile And LastSave > SumLastSave Then
'**Extracts data--works fine
Exit Do
'No match was found and at first empty row, make new entry on the summary doc
ElseIf strSumDoc = "" Then
'copy info to last row
'MsgBox "Copy to last row " & myFile.Name
strSumDoc = myFile
Set docWord = appWord.documents.Open(strSumDoc) '**Throws error because file name changed but there should be no file left.
tblCount = docWord.tables.Count
With docWord
With .tables(1)
'Extracts data from table, works fine
Exit Do
Else: 'iteration doesn't match myfile, loop to next row
End If
i = i + 1
Loop
End If
Next
appWord.Quit
Set appWord = Nothing
End Sub