PDA

View Full Version : Save As Help



ALISON520
05-17-2016, 10:04 AM
Hello

I have this code and I want to add Save As non macro workbook. This code below allows me to save as a cell value but I need both.
Code:
Option Explicit


Sub SaveAsExample()
Dim FName As String
Dim FPath As String
FPath = "C:"
FName = Sheets("Sheet1").Range("A1").Text
ThisWorkbook.SaveAs Filename:=FPath & "\" & FName
End Sub

GTO
05-18-2016, 12:49 AM
Hello

I have this code and I want to add Save As non macro workbook. This code below allows me to save as a cell value but I need both.


Greetings and welcome to VBAExpress Alison :hi:

I'm not sure exactly what you meant by needing "both", but here is a shot at it. I think you will want to consider possible errors when doing the SaveAs, such as an empty string in A1, illegal filename characters and what if the file already exists? There are certainly several ways of going about the task, here is one, lightly tested...


p
Option Explicit

Sub SaveAsExample()
Dim FName As String
Dim FPath As String

FPath = "I:\_atmp\"
FName = ThisWorkbook.Worksheets("Sheet1").Range("A1").Text

If IllegalFileName(FName) Or (Len(FName) = 0) Then
If Dir(FPath & FName & ".xls?") = vbNullString Then
' Since you are using a macro enabled workbook, we will want to kill alerts to avoid the
' warning about losing the vbproject
Application.DisplayAlerts = False
ThisWorkbook.SaveAs FPath & FName, &H33&
Application.DisplayAlerts = True
Else
MsgBox "' " & FPath & Dir(FPath & FName & ".xls?") & "' already exists.", vbInformation, vbNullString

End If
Else

MsgBox "You have character(s): '" & FName & "' included in the proposed filename. Windows does not allow this. Please rename...", vbInformation Or vbOKOnly, "Error: bad filename"

End If

End Sub

Public Function IllegalFileName(ByRef ProposedFileNameOrBadCharReturned As String) As Boolean
' Each preceding reverse solidus is to ensure the following character is understood as literal. The
' '\x22' is hex for Chr(34) (a quote mark)
Const ILLEGAL_CHARS As String = "[\\\/\:\*\?\<\>\|\x22]"
' Late-Bound | Early-Bound
Static REX As Object ' VBScript_RegExp_55.RegExp
Dim rexM As Object ' VBScript_RegExp_55.Match
Dim rexMC As Object ' VBScript_RegExp_55.MatchCollection

Dim sTmp As String

If REX Is Nothing Then
Set REX = CreateObject("VBScript.RegExp")
With REX
.Global = True
.MultiLine = False
.Pattern = ILLEGAL_CHARS
End With
End If

If REX.Test(ProposedFileNameOrBadCharReturned) Then

For Each rexM In REX.Execute(ProposedFileNameOrBadCharReturned)
sTmp = sTmp & rexM
Next
ProposedFileNameOrBadCharReturned = sTmp

IllegalFileName = False
Else
IllegalFileName = True
End If

End Function


Hope that helps,

Mark

Aflatoon
05-18-2016, 02:05 AM
Mark,
Why on earth would you use &H33&? :dunno

GTO
05-18-2016, 02:10 AM
Hi Rory,

I think that is equal to xlOpenXMLWorkbook and that xlOpenXMLWorkbook is .xlsx right? Am I missing something?

Mark

Aflatoon
05-18-2016, 02:27 AM
Yes - my question was really why would you put &H33& rather than xlOpenXMLWorkbook or even just 51?

GTO
05-18-2016, 03:14 AM
Ahh, thank you for the clarification Rory. I was staring at the screen for a bit wondering what painfully clear thing I missed.:eek:

No real reason for hex over dec. I didn't use the named constant out of habit I guess; though I obviously was too lazy to include if we're in 2003 or before...

@Alison:

I do not have Excel 2003 or before available at the moment, but I think this would handle in case that is a possibility.




Sub SaveAsExample()
Dim FName As String
Dim FPath As String

FPath = "I:\_atmp\"
FName = ThisWorkbook.Worksheets("Sheet1").Range("A1").Text

If IllegalFileName(FName) Or (Len(FName) = 0) Then
If Dir(FPath & FName & ".xls?") = vbNullString Then

If Val(Application.Version) >= 12 Then '<-- 2007 and thereafter

' Since you are using a macro enabled workbook, we will want to kill alerts to avoid the
' warning about losing the vbproject
Application.DisplayAlerts = False
ThisWorkbook.SaveAs FPath & FName, 51
Application.DisplayAlerts = True

Else '<-- Else 97-2003

ThisWorkbook.SaveAs FPath & FName, xlExcel8 '<-- or 56

End If

Else
MsgBox "' " & FPath & Dir(FPath & FName & ".xls?") & "' already exists.", vbInformation, vbNullString

End If
Else

MsgBox "You have character(s): '" & FName & "' included in the proposed filename. Windows does not allow this. Please rename...", vbInformation Or vbOKOnly, "Error: bad filename"

End If

End Sub

I used decimal numbers for my hex-hating buddy :*)

GTO
05-18-2016, 03:16 AM
Sigh... I seriously have the attention span of a gnat. Here is a link Alison, in case you need a better example of handling the version we are running in: http://www.rondebruin.nl/win/s5/win001.htm

ALISON520
05-18-2016, 07:55 AM
Thank you all.... Here are some clarifications...

I am using excel 2010
I need it to 1. Save as non macro workbook and 2. Save as cell value
No need to include illegal file names and no need to account for errors.
Anything simple is preferred.

Thank you again for your help!

Aflatoon
05-18-2016, 08:04 AM
Then just change this:

ThisWorkbook.SaveAs Filename:=FPath & "\" & FName
to this:

ThisWorkbook.SaveAs Filename:=FPath & "\" & FName, Fileformat:=xlOpenXMLWorkbook

ALISON520
05-19-2016, 01:29 PM
Then just change this:

ThisWorkbook.SaveAs Filename:=FPath & "\" & FName
to this:

ThisWorkbook.SaveAs Filename:=FPath & "\" & FName, Fileformat:=xlOpenXMLWorkbook

GTO
05-20-2016, 01:12 AM
As you indicated saveas a non-macro workbook, I am sure we are both presuming that you have Excel 2007 or newer. Just to be sure... what version of Excel are you trying this in?
Are you really trying to save in the root directory?
What is the text showing in cell A1?


Also, regardless of the folder/directory you are saving in, by example let us say "C:\Users\alison\Documents\", the trailing separator needs included.