Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations wOOdy-Soft on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Save active Excel file to new location

Status
Not open for further replies.
Rick_Stanich

Rick_Stanich

Technical User
Jun 8, 2023
29
US
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: 
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.

 
Sort by date Sort by votes
I would try:

Code: 
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
 
Upvote 0 Downvote
Thank you for your input.
I found changing the string from:
Code: 
objXL.SaveAs "C:\Users\Public\Documents\Zeiss\CALYPSO\workarea\results\Excel Files" & "\" & sFileName & "\" & objXL.ActiveWorkbook.Name
to
Code: 
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
 
Upvote 0 Downvote
sFileName - that's new... [ponder]

...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
 
Upvote 0 Downvote
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: 
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
 
Upvote 0 Downvote
Have you tried my suggestion of[tt]
...SaveAs [blue]Filename:=[/blue]"C:\...[/tt]
[ponder]

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson
 
Upvote 0 Downvote
Yes, it generated an error.
This is Line 27.

Code: 
objXL.ActiveWorkbook.SaveAs Filename:= "C:\Users\Public\Documents\Zeiss\CALYPSO\workarea\results\Excel Files" & "\" & s & "\" & objXL.ActiveWorkbook.Name
and
Code: 
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
 
 https://files.engineering.com/getfile.aspx?folder=559985d5-79a9-4ac2-9737-bebc8c922e16&file=Line_27.JPG
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

Swi
  • Locked
  • Question
Excel Webservice
Replies
2
Views
530
mintjulep
M
S
  • Locked
  • Question
MS Project - how to add a new task into an existing baseline
Replies
0
Views
253
selazar
S
Kennelbloke
  • Locked
  • Solved
Excel Unique-Filter issue
Replies
3
Views
471
SkipVought
S
BugZap13
  • Locked
  • Question
Excel formula to count occurrences of a value in a different sheet
Replies
5
Views
900
bs6600
bs6600
techguy2010
  • Locked
  • Question
Excel macro to send e-mail to multiple agents with a different body for each 1
Replies
3
Views
735
techguy2010
techguy2010

Part and Inventory Search

Sponsor

Back
Top