CODEWITHSUNDEEP
excelvba
coder
coder

Reputation: 47

How to save files in a loop to xlsm macro enabled format?

I have the following code that loops through files and saves them as new files.

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

However the files keep saving as xlsx files in the loop and not macro enabled files with xlsm format. I also see that the files are saved with this type "Microsoft Excel 97-2003 Worksheet".. This format is supposed to be Microsoft macro enabled workbook as i use FileFormat:=xlOpenXMLWorkbookMacroEnabled. enter image description here

Also how do i remove this pop up when i try to open the generated files above ? I tried to use Application.DisplayAlerts = False. However this doesn't seem to work. enter image description here

Upvotes: 1

Views: 91

Answers (1)

VBasic2008
VBasic2008

Reputation: 54807

Save File in Another Format

  • When changing the format of a file, you have to change both, its extension and the FileFormat parameter.
  • Also, note that column MZ is column 364, not 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

Upvotes: 1

Related Questions