Я новичок в макросах VBA. После запуска этого макроса, который действительно запускается при его открытии, Excel не отвечает. Этот макрос предназначен для очистки HTML-файлов. Цель состоит в том, чтобы очистить и преобразовать html-файлы в xlsx-файлы, чтобы я мог преобразовать их в .csv через python. Все строки этого кода закомментированы.
Я пишу что-то, потому что мне не разрешено писать только код. Сегодня солнечный день, и все идет хорошо. За исключением макроса, который не работает.
Пожалуйста, предоставьте мне поддержку.
Спасибо
Sub SaveFile(FileName As String)
'declare variables
Dim InitLocation As String
Dim FileFormat
'specify the location where the new files will be saved
InitLocation = "\\ITWS2162\work\SCM\RawData\FADP\FADP Monthly Bucket\CSV\"
'specify the format we will be saving as
FileFormat = ".xlsx"
'save the workbook under specified location, specified format, with name provided when function is called
ActiveWorkbook.SaveAs FileName:=InitLocation & FileName & FileFormat, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
Sub DeleteRowsMcr()
'delete rows we dont need
Range("A1, A2, A3, A4, A5, A6, A7").EntireRow.Delete
End Sub
Sub openMyfile()
'Declare variables
Dim InitLocation As String
Dim StrFile As String
Dim Extension As String
Dim FileNo As Integer
Dim FileName As String
'specify what to do in case of error'
On Error GoTo errhndl
'hide warnings (like extension being wrong etc - so that no manual actions are required)
With Application
.DisplayAlerts = False
.AlertBeforeOverwriting = False
.ScreenUpdating = False
End With
'start numerating the files
FileNo = 1
InitLocation = "\\ITWS2162\work\SCM\RawData\FADP\FADP Monthly Bucket\"
StrFile = Dir(InitLocation)
'extension that we will be checking for
Extension = "xls"
'a loop that goes through files in the provided path (until no files are left)
Do While Len(StrFile) > 0
'check if the extenstion matches the required one
If LCase(Right(StrFile, 3)) = Extension Then
'open the file
Workbooks.Open FileName:=InitLocation & StrFile
'numerate to the next file
StrFile = Dir()
'wait for the above to finish
DoEvents
'prepare name of the file which will be used when saving it
FileName = "FixedExcel_" & FileNo
'call macro to delete unwanted rows
Call DeleteRowsMcr
'Save the file under the prepared name, inside location specified in the function SaveFile
Call SaveFile(FileName)
'Close the workbook that has just been saved
ActiveWorkbook.Close
'numerate for the next filename
FileNo = FileNo + 1
End If
Loop
'Bring back the warning
With Application
.DisplayAlerts = True
.AlertBeforeOverwriting = True
.ScreenUpdating = True
End With
'try to quit the file
ThisWorkbook.Saved = True
Application.Quit
'end the macro - skipping the below error message
End
'in case of error go to this line
errhndl:
MsgBox "An error has occured, please check if the files are available and accessible"
End Sub
Private Sub Workbook_Open()
'automatically call the macro when workbook is opened
Call openMyfile
End Sub