Excel не отвечает после VBA Macro - PullRequest
0 голосов
/ 03 октября 2019

Я новичок в макросах 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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...