PTech2011
02-07-2011, 11:19 AM
Hello, first post here.
I have a program that pulls several sheets depending on choice and certain data to name the file when it's exported to a Excel document. Problem is, I would like the program to save everything as a default 97-2003 .xsl document. Right not, even though I default my settings are to 97-2003. I get the compatibility pop up. I found a generic script on the net and was wondering is anyone can look at what I found (Works but does not save it the way I want) and my script. Can anyone help me?
Found this, like I said, saves to proper format
Sub Save_2007_WorkSheet_As_97_2003_Workbook()
Dim Destwb As Workbook
Dim SaveFormat As Long
Dim TempFilePath As String
Dim TempFileName As String
SaveFormat = Application.DefaultSaveFormat
Application.DefaultSaveFormat = 56
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
Destwb.CheckCompatibility = False
TempFilePath = Application.DefaultFilePath & "\"
TempFileName = "Excel 97-2003 WorkBook " & Format(Now, "yyyy-mm-dd hh-mm-ss")
With Destwb
.SaveAs TempFilePath & TempFileName & ".xls", FileFormat:=56
.Close SaveChanges:=False
End With
Application.DefaultSaveFormat = SaveFormat
MsgBox "You can find the file in " & Application.DefaultFilePath
End Sub
=======================================
Here's my script
=======================================
Private Sub Label1_Click()
Dim FNameDefault As String, FName As String
Dim wb As Workbook
FNameDefault = Range("AX2").Text & " " & Range("F12").Text & " " & _
Range("AL13").Text & " " & Format(Range("AX1").Text, "yymmdd")
ThisWorkbook.Sheets(Array("Maintenance Data Sheet", _
"Field Activity Report")).Copy
Set wb = Workbooks(Workbooks.Count)
Do
FName = Application.GetSaveAsFilename(Range("AX2").Text + " " _
+ Range("AX3").Text + " " _
+ Range("F12").Text + " " + Range("AL13").Text + " " _
+ Format(Range("AX1").Text, "yymmdd") + " FAR", "Excel Files (*.xls), *.xls,All Files (*.*),*.*") Loop Until FName <> ""
wb.SaveAs FName
wb.Close
FNameDefault = FNameDefault & " Invoice"
ThisWorkbook.Sheets("Invoice").Copy
Set wb = Workbooks(Workbooks.Count)
Do
FName = Application.GetSaveAsFilename(Range("AX2").Text + " " _
+ Range("AX3").Text + " " _
+ Range("F12").Text + " " + Range("AL13").Text + " " _
+ Format(Range("AX1").Text, "yymmdd") + " Invoice", "Excel Files (*.xls), *.xls,All Files (*.*),*.*") Loop Until FName <> ""
wb.SaveAs FName
wb.Close
Set wb = Nothing End Sub
I have a program that pulls several sheets depending on choice and certain data to name the file when it's exported to a Excel document. Problem is, I would like the program to save everything as a default 97-2003 .xsl document. Right not, even though I default my settings are to 97-2003. I get the compatibility pop up. I found a generic script on the net and was wondering is anyone can look at what I found (Works but does not save it the way I want) and my script. Can anyone help me?
Found this, like I said, saves to proper format
Sub Save_2007_WorkSheet_As_97_2003_Workbook()
Dim Destwb As Workbook
Dim SaveFormat As Long
Dim TempFilePath As String
Dim TempFileName As String
SaveFormat = Application.DefaultSaveFormat
Application.DefaultSaveFormat = 56
ActiveSheet.Copy
Set Destwb = ActiveWorkbook
Destwb.CheckCompatibility = False
TempFilePath = Application.DefaultFilePath & "\"
TempFileName = "Excel 97-2003 WorkBook " & Format(Now, "yyyy-mm-dd hh-mm-ss")
With Destwb
.SaveAs TempFilePath & TempFileName & ".xls", FileFormat:=56
.Close SaveChanges:=False
End With
Application.DefaultSaveFormat = SaveFormat
MsgBox "You can find the file in " & Application.DefaultFilePath
End Sub
=======================================
Here's my script
=======================================
Private Sub Label1_Click()
Dim FNameDefault As String, FName As String
Dim wb As Workbook
FNameDefault = Range("AX2").Text & " " & Range("F12").Text & " " & _
Range("AL13").Text & " " & Format(Range("AX1").Text, "yymmdd")
ThisWorkbook.Sheets(Array("Maintenance Data Sheet", _
"Field Activity Report")).Copy
Set wb = Workbooks(Workbooks.Count)
Do
FName = Application.GetSaveAsFilename(Range("AX2").Text + " " _
+ Range("AX3").Text + " " _
+ Range("F12").Text + " " + Range("AL13").Text + " " _
+ Format(Range("AX1").Text, "yymmdd") + " FAR", "Excel Files (*.xls), *.xls,All Files (*.*),*.*") Loop Until FName <> ""
wb.SaveAs FName
wb.Close
FNameDefault = FNameDefault & " Invoice"
ThisWorkbook.Sheets("Invoice").Copy
Set wb = Workbooks(Workbooks.Count)
Do
FName = Application.GetSaveAsFilename(Range("AX2").Text + " " _
+ Range("AX3").Text + " " _
+ Range("F12").Text + " " + Range("AL13").Text + " " _
+ Format(Range("AX1").Text, "yymmdd") + " Invoice", "Excel Files (*.xls), *.xls,All Files (*.*),*.*") Loop Until FName <> ""
wb.SaveAs FName
wb.Close
Set wb = Nothing End Sub