Question

我有以下代码循环遍历文件并将它们另存为新文件。

Sub ImportWorksheets()
   '=============================================
   'Process all Excel files in specified folder
   '=============================================
   Dim sFile As String           'file to process
   Dim wbTarget As Workbook
   Dim wsTarget As Worksheet
   Dim wsHide1 As Worksheet 'Declare Sheets to hide'
   Dim wsHide2 As Worksheet
   Dim wsHide3 As Worksheet
   Dim wsHide4 As Worksheet
   Dim wbSource As Workbook
   Dim wsSource As Worksheet
   Dim rowTarget As Long 'output row

   'Master workbook row that needs to be updated with source data'
   rowTarget = 9
   
   'Source files location'
   Const FOLDER_PATH = "T:\SAMPLE DATA\1 - Split Raw Files\"

   'loop through the Excel files in the folder'
  sFile = Dir(FOLDER_PATH & "*.xls*")
  
'open template'
    Const MASTER = "T:\SAMPLE DATA\ V7 Template\Tool Template V7.xlsm"
    Set wbTarget = Workbooks.Open(MASTER)
   
    Set wsTarget = Sheets("DATABASE") 'Target sheet of where data from source needs to be inserted'
    
    'Sheets to hide'
    Set wsHide1 = Sheets("Office Use Only1")
    Set wsHide2 = Sheets("Office Use Only2")
    Set wsHide3 = Sheets("Office Use Only3")
    Set wsHide4 = Sheets("Office Use Only4")
    
         wsTarget.Visible = xlVeryHidden
         wsHide1.Visible = xlVeryHidden
         wsHide2.Visible = xlVeryHidden
         wsHide3.Visible = xlVeryHidden
         wsHide4.Visible = xlVeryHidden

    Do While sFile <> ""
    
        ' read source
        Set wbSource = Workbooks.Open(FOLDER_PATH & sFile) ' update links, readonly
        Set wsSource = wbSource.Sheets(1)
          
        ' create target'
        'wsTarget.Name = Replace(sFile, ".xlsx", "")'
        wsTarget.Name = "DATABASE"
        wsTarget.Unprotect "Password"
        wsTarget.Range("A" & rowTarget).Resize(1, 364) = wsSource.Range("A2:MZ2").Value
        wbTarget.SaveAs "T:\SAMPLE DATA\2 -Final  Files\" & sFile & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
        CreateBackup:=False
        wsTarget.Protect "Password"
        Application.DisplayAlerts = False 'Remove pop up messages'
        wbSource.Close False
    
        sFile = Dir
         wsTarget.Visible = xlVeryHidden
         wsHide1.Visible = xlVeryHidden
         wsHide2.Visible = xlVeryHidden
         wsHide3.Visible = xlVeryHidden
         wsHide4.Visible = xlVeryHidden
    Loop
    wbTarget.Close False

End Sub

然而，这些文件在循环中一直保存为 xlsx 文件，而不是 xlsm 格式的启用宏的文件。我还看到文件是用这种类型“Microsoft Excel 97-2003 工作表”保存的。这种格式应该是启用了 Microsoft 宏的工作簿，因为我使用 FileFormat:=xlOpenXMLWorkbookMacroEnabled。

当我尝试打开上面生成的文件时，如何删除这个弹出窗口？我尝试使用 Application.DisplayAlerts = False。但是，这似乎不起作用。

Answer 1

以另一种格式保存文件

更改文件格式时，您必须同时更改其扩展名和 FileFormat 参数。
另外，请注意 MZ 列是 364 列，而不是 347。

Dim NewName As String
NewName = "T:\SAMPLE DATA\2 - Files\" & "test- " & sFile
NewName = Left(NewName, InStrRev(NewName, ".")) & "xlsm"
Application.DisplayAlerts = False 'Remove pop up messages'
wbTarget.SaveAs NewName, FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
    CreateBackup:=False
wsTarget.Protect "Password"
wbSource.Close False
Application.DisplayAlerts = True

如何将循环中的文件保存为启用 xlsm 宏的格式？

1 个答案:

以另一种格式保存文件