Save active Excel file to new location

[Rick_Stanich]

Hello
I am trying to save an open (active) Excel file to a new location automatically.
I created a VBS program, which I wrote initially in VBA but I am loosing something when using VBS.
The SaveAs portion will not complete and gives no errors or warning.
I am temporarily using a MsgBox to see if I do get the file name.

The VBS program will be activated by PCM (A CMM programming language).

Dim objXL, strMessage

On Error Resume Next

Set objXL = GetObject(,"Excel.Application")

If Not TypeName(objXL) = "Empty" then
    'strMessage = "Excel Running"    
    MsgBox "The active workbook name is " & objXL.ActiveWorkbook.Name  'for testing, retrieves active workbook name ok
    objXL.SaveAs "C:\Users\Public\Documents\Zeiss\CALYPSO\workarea\results\Excel Files" & "\" & objXL.ActiveWorkbook.Name  'this line fails to save as	
Else 
    MsgBox "No active Excel file open."
End If

Any help with this is appreciated.

Regards.

 

[Andrzejek]

I would try:

Dim objXL, strMessage

[s]On Error Resume Next[/s]

Set objXL = GetObject(,"Excel.Application")

If Not TypeName(objXL) = "Empty" then
    MsgBox "The active workbook name is " & objXL.ActiveWorkbook.Name  
    objXL.SaveAs [highlight #FCE94F]Filename:=[/highlight]"C:\Users\Public\Documents\Zeiss\CALYPSO\workarea\results\Excel Files\" & objXL.ActiveWorkbook.Name  
Else 
    MsgBox "No active Excel file open."
End If

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[Rick_Stanich]

Thank you for your input.
I found changing the string from:

objXL.SaveAs "C:\Users\Public\Documents\Zeiss\CALYPSO\workarea\results\Excel Files" & "\" & sFileName & "\" & objXL.ActiveWorkbook.Name

to

objXL.ActiveWorkbook.SaveAs "C:\Users\Public\Documents\Zeiss\CALYPSO\workarea\results\Excel Files" & "\" & sFileName & "\" & objXL.ActiveWorkbook.Name

worked.

I will test your suggestion for knowledge.


Rick Stanich
CMM Programming and Consulting

 

[Andrzejek]

sFileName - that's new...

...Excel Files\" & [red]sFileName[/red] & "\" & [red]objXL.ActiveWorkbook.Name [/red]

Wouldn't you get 2 file names this way...? Unless sFileName is a sub-folder.

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[Rick_Stanich]

sFileName is a Folder.

My prior post of how the file SaveAs is working is not working...

The code has been modified with code from user: strongm (Thank you).

I appear to need assistance with "saving as". It has decided to no longer function.
I added a MsgBox for the "Phantom" choice (Current file in use) and the string is constructed properly, just no file is being saved as.

Dim objXL, strMessage


On Error Resume Next

Set objXL = GetObject(,"Excel.Application")

If Not TypeName(objXL) = "Empty" then 
    'MsgBox "The active workbook name is - " & objXL.ActiveWorkbook.Name  'for testing, retrieves active workbook name ok

	    If Left(objXL.ActiveWorkbook.Name,18) = "Ruby Head_Rev 2_Op" Then  'uses generic file naming
			[COLOR=#73D216]s = objXL.ActiveWorkbook.Name
			t = Split(s, "_")
			ReDim Preserve t(2)
			s = Join(t, "_")[/color]
			MsgBox "Generic - " & s  'for testing
			objXL.ActiveWorkbook.SaveAs "C:\Users\Public\Documents\Zeiss\CALYPSO\workarea\results\Excel Files" & "\" & s & "\" & objXL.ActiveWorkbook.Name
		End If
		
			If Left(objXL.ActiveWorkbook.Name,26) = "Ruby Head_Rev 2_Phantom_Op" Then  'uses Phantom file naming
			s = objXL.ActiveWorkbook.Name
			t = Split(s, "_")
			ReDim Preserve t(3)
			s = Join(t, "_")
			MsgBox "Phantom - " & s  'for testing
			objXL.ActiveWorkbook.SaveAs "C:\Users\Public\Documents\Zeiss\CALYPSO\workarea\results\Excel Files" & "\" & s & "\" & objXL.ActiveWorkbook.Nam
					[COLOR=#FCE94F]MsgBox "C:\Users\Public\Documents\Zeiss\CALYPSO\workarea\results\Excel Files" & "\" & s & "\" & objXL.ActiveWorkbook.Name 'for testing[/color]
		End If

		If Left(objXL.ActiveWorkbook.Name,24) = "Ruby Head_Rev 2_Sabre_Op" Then  'uses Sabre file naming
			s = objXL.ActiveWorkbook.Name
			t = Split(s, "_")
			ReDim Preserve t(3)
			s = Join(t, "_")
			MsgBox "Sabre - " & s  'for testing		
			objXL.ActiveWorkbook.SaveAs "C:\Users\Public\Documents\Zeiss\CALYPSO\workarea\results\Excel Files" & "\" & s & "\" & objXL.ActiveWorkbook.Name
		End If
	Else 
    MsgBox "No active Excel file open."
End If

Rick Stanich
CMM Programming and Consulting

 

[Andrzejek]

Have you tried my suggestion of[tt]
...SaveAs [blue]Filename:=[/blue]"C:\...[/tt]


---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson

 

[Rick_Stanich]

Yes, it generated an error.
This is Line 27.

objXL.ActiveWorkbook.SaveAs Filename:= "C:\Users\Public\Documents\Zeiss\CALYPSO\workarea\results\Excel Files" & "\" & s & "\" & objXL.ActiveWorkbook.Name

and

objXL.SaveAs Filename:= "C:\Users\Public\Documents\Zeiss\CALYPSO\workarea\results\Excel Files" & "\" & s & "\" & objXL.ActiveWorkbook.Name

I tried the above without the space after the "=" sign as well.

Rick Stanich
CMM Programming and Consulting