bozo88
bozo88

Reputation: 11

Does Excel VBA SaveAs do anything different to File SaveAs

This is slightly maddening..

I have an Excel XLSM workbook that downloads data from a database, transforms into a load template for the accounting system, create the journal template and saves as a XLSX file that should be compatible with the load process.

The load process is complain about 'External table is not in the expected format'

However if I do nothing more than open up the saved file and then re-save, the file will load successfully.

This suggest to me that the Excel VBA SaveAs is doing something that the File Save is (or is not) doing.

I have tried changing FileFormat from xlWorkbookDefault to xlOpenXMLWorkbook (same value) with no difference.

Excel version

Microsoft® Excel® for Microsoft 365 MSO (Version 2306 Build 16.0.16529.20100) 64-bit

The VBA save code

Sub SaveJournalWorksheet()
    Dim saveDate As String
    Dim savePath As String
    saveDate = Format(Application.Range("reportDate"), "YYYYMMDD")
    shtJnl.Activate
    shtJnl.copy
    ActiveWorkbook.SaveAs Filename:="C:\Temp\Daily Journals\Daily_Sales_Journal_Combined_" & saveDate, FileFormat:=xlOpenXMLWorkbook
    ActiveWorkbook.Close
    shtGroup.Activate
    shtGroup.copy
    ActiveWorkbook.SaveAs Filename:="C:\Temp\Daily Journals\Daily_Sales_Journal_Group_" & saveDate, FileFormat:=xlOpenXMLWorkbook
    ActiveWorkbook.Close
End Sub

Upvotes: 1

Views: 611

Answers (3)

Sub CreateVeluxPresentation()
    Dim pptApp As Object
    Dim pptPres As Object
    Dim slideIndex As Integer
    
    ' Kreiraj novu PowerPoint aplikaciju
    Set pptApp = CreateObject("PowerPoint.Application")
    pptApp.Visible = True
    Set pptPres = pptApp.Presentations.Add
    
    ' Dodaj slajdove i sadržaj
    slideIndex = 1
    
    ' 1. Naslovni slajd
    With pptPres.Slides.Add(slideIndex, ppLayoutTitle)
        .Shapes(1).TextFrame.TextRange.Text = "VELUX"
        .Shapes(2).TextFrame.TextRange.Text = "Istorija, proizvodi i inovacije"
    End With
    slideIndex = slideIndex + 1
    
    ' 2. Uvod
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Uvod"
        .Shapes(2).TextFrame.TextRange.Text = "VELUX je globalni lider u proizvodnji krovnih prozora i rešenja za osvetljavanje."
    End With
    slideIndex = slideIndex + 1
    
    ' 3. Osnivanje kompanije
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Osnivanje"
        .Shapes(2).TextFrame.TextRange.Text = "Kompanija je osnovana 1941. godine u Danskoj."
    End With
    slideIndex = slideIndex + 1
    
    ' 4. Misija i vizija
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Misija i vizija"
        .Shapes(2).TextFrame.TextRange.Text = "Da poboljšamo kvalitet života ljudi kroz prirodno osvetljenje."
    End With
    slideIndex = slideIndex + 1
    
    ' 5. Proizvodi
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Proizvodi"
        .Shapes(2).TextFrame.TextRange.Text = "Krovni prozori, rolete, sistemi za ventilaciju i drugi proizvodi."
    End With
    slideIndex = slideIndex + 1
    
    ' 6. Tehnologija
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Tehnologija"
        .Shapes(2).TextFrame.TextRange.Text = "Inovacije u dizajnu i efikasnosti energije."
    End With
    slideIndex = slideIndex + 1
    
    ' 7. Ekološki pristup
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Ekološki pristup"
        .Shapes(2).TextFrame.TextRange.Text = "Održivost i ekološki prihvatljivi proizvodi."
    End With
    slideIndex = slideIndex + 1
    
    ' 8. Globalna prisutnost
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Globalna prisutnost"
        .Shapes(2).TextFrame.TextRange.Text = "Prodaja u više od 40 zemalja širom sveta."
    End With
    slideIndex = slideIndex + 1
    
    ' 9. Inovacije
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Inovacije"
        .Shapes(2).TextFrame.TextRange.Text = "Kontinuirani razvoj i unapređenje proizvoda."
    End With
    slideIndex = slideIndex + 1
    
    ' 10. Partnerstva
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Partnerstva"
        .Shapes(2).TextFrame.TextRange.Text = "Saradnja sa arhitektama i građevinskim firmama."
    End With
    slideIndex = slideIndex + 1
    
    ' 11. Brošure
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Brošure"
        .Shapes(2).TextFrame.TextRange.Text = "Pogledajte brošure za detaljnije informacije." & vbCrLf & "Link: https://www.velux.rs/podrska-kupcima/brosure"
    End With
    slideIndex = slideIndex + 1
    
    ' 12. Video sadržaj
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Video sadržaj"
        .Shapes(2).TextFrame.TextRange.Text = "Prikaz proizvoda i inovacija." & vbCrLf & "Link: https://www.youtube.com/watch?v=zV1HaL7kqj4"
    End With
    slideIndex = slideIndex + 1
    
    ' 13. Video 2
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Video 2"
        .Shapes(2).TextFrame.TextRange.Text = "Još jedan uvid u VELUX proizvode." & vbCrLf & "Link: https://www.youtube.com/watch?v=ZqnWtUNzkII"
    End With
    slideIndex = slideIndex + 1
    
    ' 14. Video 3
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Video 3"
        .Shapes(2).TextFrame.TextRange.Text = "Inovacije u akciji." & vbCrLf & "Link: https://www.youtube.com/watch?v=Z65pdmE53RA"
    End With
    slideIndex = slideIndex + 1
    
    ' 15. Video 4
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Video 4"
        .Shapes(2).TextFrame.TextRange.Text = "Dodatne informacije o proizvodima." & vbCrLf & "Link: https://www.youtube.com/watch?v=1EuiHYQXDXE"
    End With
    slideIndex = slideIndex + 1
    
    ' 16. Načini korišćenja
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Načini korišćenja"
        .Shapes(2).TextFrame.TextRange.Text = "Kako koristiti VELUX proizvode u vašem domu."
    End With
    slideIndex = slideIndex + 1
    
    ' 17. Reference
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Reference"
        .Shapes(2).TextFrame.TextRange.Text = "Korisni linkovi i literatura."
    End With
    slideIndex = slideIndex + 1
    
    ' 18. FAQ
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Česta pitanja"
        .Shapes(2).TextFrame.TextRange.Text = "Odgovori na najčešće postavljana pitanja."
    End With
    slideIndex = slideIndex + 1
    
    ' 19. Kontakt
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Kontakt"
        .Shapes(2).TextFrame.TextRange.Text = "Informacije o kontaktu i podršci."
    End With
    slideIndex = slideIndex + 1
    
    ' 20. Zaključak
    With pptPres.Slides.Add(slideIndex, ppLayoutText)
        .Shapes(1).TextFrame.TextRange.Text = "Zaključak"
        .Shapes(2).TextFrame.TextRange.Text = "VELUX kao lider u inovacijama u osvetljavanju."
    End With
    
    ' Čuvanje prezentacije
    pptPres.SaveAs "C:\Users\TvojeKorisnickoIme\Documents\VeluxPresentation.pptx"
    
    ' Oslobodi resurse
    Set pptPres = Nothing
    Set pptApp = Nothing
End Sub

Upvotes: -1

VBasic2008
VBasic2008

Reputation: 54817

Export Sheet to a New .xlsx Workbook

  • This will only work when saving to a .xlsx file. Otherwise, always supply the correct file extension and the corresponding parameter for the FileFormat argument of the SaveAs method.

Compact (Repeating Code)

Sub SaveJournalWorksheet()
    
    Dim sDate: sDate = ThisWorkbook.Names("ReportDate").RefersToRange.Value
    
    If Not IsDate(sDate) Then
        MsgBox "The save date """ & CStr(sDate) & """ is invalid.", vbCritical
        Exit Sub
    End If
    
    Dim SaveDate As String: SaveDate = Format(sDate, "YYYYMMDD")
    
    Dim SavePath As String
    
    SavePath = "C:\Temp\Daily Journals\Daily_Sales_Journal_Combined_" & SaveDate
    shtJnl.Copy
    With Workbooks(Workbooks.Count)
        Application.DisplayAlerts = False ' overwrite without confirmation
            .SaveAs Filename:=SavePath
        Application.DisplayAlerts = True
        .Close SaveChanges:=False ' it just got saved
    End With
    
    SavePath = "C:\Temp\Daily Journals\Daily_Sales_Journal_Group_" & SaveDate
    shtGroup.Copy
    With Workbooks(Workbooks.Count)
        Application.DisplayAlerts = False ' overwrite without confirmation
            .SaveAs Filename:=SavePath
        Application.DisplayAlerts = True
        .Close SaveChanges:=False ' it just got saved
    End With

End Sub

Using a Helper Method (Sub) - Main (The Calling Procedure)

Sub SaveJournalWorksheetUsingMethod()
    
    Dim sDate: sDate = ThisWorkbook.Names("ReportDate").RefersToRange.Value
    
    If Not IsDate(sDate) Then
        MsgBox "The save date """ & CStr(sDate) & """ is invalid.", vbCritical
        Exit Sub
    End If
    
    Dim SaveDate As String: SaveDate = Format(sDate, "YYYYMMDD")
    
    Dim SavePath As String
    
    SavePath = "C:\Temp\Daily Journals\Daily_Sales_Journal_Combined_" & SaveDate
    ExportSheetToXLSX shtJnl, SavePath
    
    SavePath = "C:\Temp\Daily Journals\Daily_Sales_Journal_Group_" & SaveDate
    ExportSheetToXLSX shtGroup, SavePath
    
End Sub

Using a Helper Method (Sub) - The Method

Sub ExportSheetToXLSX( _
        ByVal Sheet As Object, _
        ByVal FilePath As String)
    
    Sheet.Copy
    
    With Workbooks(Workbooks.Count)
        Application.DisplayAlerts = False ' overwrite without confirmation
            .SaveAs Filename:=FilePath
        Application.DisplayAlerts = True
        .Close SaveChanges:=False ' it just got saved
    End With

End Sub

Upvotes: 1

Tim Williams
Tim Williams

Reputation: 166366

Try adding the file extension: eg -

Sub SaveJournalWorksheet()
    Const FLDR As String = "C:\Temp\Daily Journals\"
    Dim savePart As String
    
    'include the extension
    savePart = Format(Application.Range("reportDate"), "YYYYMMDD") & ".xlsx"
    
    SaveSheetToFile shtJnl, FLDR & "Daily_Sales_Journal_Combined_" & savePart
    SaveSheetToFile shtGroup, FLDR & "Daily_Sales_Journal_Group_" & savePart
End Sub

'copy `ws` as a new workbook, and save the new workbook to `savePath`
Sub SaveSheetToFile(ws As Worksheet, savePath As String)
    ws.Copy
    With ActiveWorkbook
        .SaveAs fileName:=savePath, FileFormat:=xlOpenXMLWorkbook
        .Close False
    End With
End Sub

Upvotes: 1

Related Questions