ChrisOjeda
Programmer
Please help...the code below saves the file as "book1.xls" to my default Excel directory (P:\my documents\) and not as test.xls to "C:\WINNT\Profiles\wojeda\Desktop\". For some reasons none of the properties of the workbook are changed?
Private Sub cmdSpecialAssets_Click()
Dim objXL As Object
Dim objActiveWkb As Object
Dim objActiveSht As String
Dim strFileName As String
Dim strPath As String ' Path to Excel document
Dim booXLOpen As Boolean ' Was Excel Open T/F
strFileName = "test.xls"
strPath = "C:\WINNT\Profiles\wojeda\Desktop\" + strFileName
' Defer error trapping.
On Error Resume Next
' Get Excel if open and assign to objXL.
' Check if no errors to verify if Excel was open.
' If Excel was open then save the users current workbook.
Set objXL = GetObject(, "Excel.Application"
If Err.Number = 0 Then
objXL.ActiveWorkbook.Close savechanges:=True ' Save and close current workbook.
booXLOpen = True
End If
' Reset all properties of the Error Object.
Err.Clear
' If Excel was not open then open Excel.
If objXL Is Nothing Then
Set objXL = CreateObject("Excel.Application"
End If
' Open Excel using the password assigned to strPassword.
objXL.WindowState = xlMaximized ' Make the Excel Window Maximized
objXL.ActiveWindow.Visible = True ' Make the active Excel window visible
objXL.Visible = True ' Make the Excel application window visible
objXL.workbooks.Add
objXL.Workbook.Name = "dddd"
Set objActiveWkb = objXL.Application.ActiveWorkbook
objActiveWkb.FullName = strFileName
objActiveWkb.Path = strPath
objXL.ActiveWorkbook.Save
objXL.Application.Quit ' Quit Excel.
Set objXL = Nothing ' Destroy Excel Application Object.
Set objActiveWkb = Nothing ' Destroy Active Workbook Object.
End Sub
Private Sub cmdSpecialAssets_Click()
Dim objXL As Object
Dim objActiveWkb As Object
Dim objActiveSht As String
Dim strFileName As String
Dim strPath As String ' Path to Excel document
Dim booXLOpen As Boolean ' Was Excel Open T/F
strFileName = "test.xls"
strPath = "C:\WINNT\Profiles\wojeda\Desktop\" + strFileName
' Defer error trapping.
On Error Resume Next
' Get Excel if open and assign to objXL.
' Check if no errors to verify if Excel was open.
' If Excel was open then save the users current workbook.
Set objXL = GetObject(, "Excel.Application"
If Err.Number = 0 Then
objXL.ActiveWorkbook.Close savechanges:=True ' Save and close current workbook.
booXLOpen = True
End If
' Reset all properties of the Error Object.
Err.Clear
' If Excel was not open then open Excel.
If objXL Is Nothing Then
Set objXL = CreateObject("Excel.Application"
End If
' Open Excel using the password assigned to strPassword.
objXL.WindowState = xlMaximized ' Make the Excel Window Maximized
objXL.ActiveWindow.Visible = True ' Make the active Excel window visible
objXL.Visible = True ' Make the Excel application window visible
objXL.workbooks.Add
objXL.Workbook.Name = "dddd"
Set objActiveWkb = objXL.Application.ActiveWorkbook
objActiveWkb.FullName = strFileName
objActiveWkb.Path = strPath
objXL.ActiveWorkbook.Save
objXL.Application.Quit ' Quit Excel.
Set objXL = Nothing ' Destroy Excel Application Object.
Set objActiveWkb = Nothing ' Destroy Active Workbook Object.
End Sub