excel - VBA宏后excel没有响应

Question

我是 VBA 宏的新手。运行此宏后，实际上在您打开它时启动，excel 没有响应。此宏旨在清理 html 文件。目标是清理和转换 xlsx 文件中的 html 文件，以便我可以通过 python 将它们转换为 .csv。这段代码的所有行都被注释掉了。

我正在写一些东西，因为我不能只写代码。今天是一个阳光明媚的日子，一切都很顺利。除了没有运行的宏。

请给我支持。

谢谢

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

标签： excelvba