×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Contact US

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Save active Excel file to new location

Save active Excel file to new location

Save active Excel file to new location

(OP)
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).

CODE --> vbs

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.

RE: Save active Excel file to new location

I would try:

CODE

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  
    objXL.SaveAs Filename:="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

RE: Save active Excel file to new location

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

CODE --> vbs

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

CODE --> vbs

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

RE: Save active Excel file to new location

sFileName - that's new... ponder

...Excel Files\" & sFileName & "\" & objXL.ActiveWorkbook.Name

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

RE: Save active Excel file to new location

(OP)
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.

CODE --> VBS

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
			s = objXL.ActiveWorkbook.Name
			t = Split(s, "_")
			ReDim Preserve t(2)
			s = Join(t, "_")
			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
					MsgBox "C:\Users\Public\Documents\Zeiss\CALYPSO\workarea\results\Excel Files" & "\" & s & "\" & objXL.ActiveWorkbook.Name 'for testing
		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

RE: Save active Excel file to new location

Have you tried my suggestion of
...SaveAs Filename:="C:\...

ponder

---- Andy

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

RE: Save active Excel file to new location

(OP)
Yes, it generated an error.
This is Line 27.

CODE --> VBS

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

CODE --> VBS

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

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members! Already a Member? Login

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close