Reputation: 11
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
Reputation: 1
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
Reputation: 54817
.xlsx
Workbook.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
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