Solved: file name via function

[white_flag]

Hello

I try to get the file name in a sub via a function (But I do not know to do't)

so the function is like this


Function GetName() As String
Dim myDocument As String

If ThisWorkbook.Name = ActiveWorkbook.Name Then
strPath = ThisWorkbook.Path & "\"
strFileName = UserForm5.Label113.Caption & UserForm5.TextBox2.Text
strExt = ".doc"
myDocument = ThisWorkbook.Path & "\" & myDocument
Else
strPath = ActiveWorkbook.Path & "\" 'Change to suit
strFileName = UserForm5.Label113.Caption & UserForm5.TextBox2.Text
strExt = ".doc"
myDocument = ActiveWorkbook.Path & "\" & myDocument
End If
End Function


in sub

Sub bookmarks()
Dim mydocu As String
mydocu = GetName()
....

Set wordDoc = GetObject(mydocu)
...
End Sub

but offcors, it is not going. So what I am doing wrong?

[white_flag]

my bad


Function myDocument$()

If ThisWorkbook.Name = ActiveWorkbook.Name Then
strPath = ThisWorkbook.Path & "\" 'Change to suit
strFileName = UserForm5.Label113.Caption & UserForm5.TextBox2.Text
strExt = ".doc"
myDocument = ThisWorkbook.Path & "\" & myDocument
Else
strPath = ActiveWorkbook.Path & "\" 'Change to suit
strFileName = UserForm5.Label113.Caption & UserForm5.TextBox2.Text
strExt = ".doc"
myDocument = ActiveWorkbook.Path & "\" & myDocument
End If

End Function

[SamT]

This is how I would write your code
Function myDocument() As String
Dim DocPath As String
Dim DocName As String
Const Separator As String = "\"
Const DocExt As String = ".doc"

'The "If ThisWorkbook = ActiveWorkbook" is redundant because
'if it isn't, you use "ActiveWorkbook" anyway.
'Hardcoding the use of ActiveWorkbook does mean that
'you have to insure the correct Workbook is active when
'calling this function.

DocPath = ActiveWorkbook.Path
DocName = UserForm5.Label113.Caption & UserForm5.TextBox2.Text

myDocument = DocPath & Separator & DocName & DocExt

End Function
This code is a bit better, you pass the parts of the name as an Array, the Ext you want as a String and, if you don't want to use the activeWorkbook, a workbook to use to get the Path from.

To CAll it:

NameParts = Array(UserForm5.Label113.Caption, UserForm5.TextBox2.Text)
MyExt = ".Doc" ' Or even "doc", the function will add the "."
MyFileName = NewFileNameWithPath(NameParts, MyExt) 'To useActiveWorkbook
'or
MyFileName = NewFileNameWithPath(NameParts, MyExt, MyWrkBook) to Use MyWorkbook to set the path.

Function NewFileNameWithPath(NameParts() As Variant, _
ExtString As String, _
Optional WrkBkForPath As Workbook) _
As String

Dim DocPath As String
Dim DocName As String
Dim Result As String 'Temp for constucting new name
Dim i As Long
Dim Message As String
Const Separator As String = "/"

'Simple Error Checking
If ExtString = "" Then
Message = "You must include the Extension"
GoTo ErrorHandler
End If

'Adjust Extension, simple method
If Left(ExtString, 1) <> "." Then _
ExtString = "." & ExtString

'Check and assign WrkBkForPath
If WrkBkForPath Is Nothing Then Set WrkBkForPath = ActiveWorkbook
'Set DocPath
DocPath = WrkBkForPath.Path

'Compute the name from all the NameParts
For i = 0 To UBound(NameParts)
DocName = DocName & NameParts(i)
Next i

Result = DocPath & Separator & DocName & ExtString
NewFileNameWithPath = Result
Exit Function
ErrorHandler:
MsgBox (Message)
End Function

[SamT]

NewFileNameWithPath above was written with the idea that I will use it in many places. The next time I have to use it I might want to add some more error checking. I can easily do that by Sending "Result" to an error checking function before I assign Result to the Function.

[snb]

I would use:


sub M_snb()
msgbox ActiveWorkbook.FullName
msgbox activeWorkbook.path & "\" & label113.caption & textbox2.text & "." & createobject("scripting.filesystemobject").getextensionname(activeworkbook.fullname)
end sub

[SamT]

snb,

I'm not sure, but I think he's trying to save a Word.doc from Excel.VBA.

SamT

ps: You've got some of the tightest VB code I've ever seen. I'm adding a snb.dir to my VBA Kb just for it.

pps: Don't think many noobs can figure out your code. I gotta use the help most times.

[snb]

I gotta use the help most times.

Me too; but I assume those helpfiles have been dsigned for that purpose :)

If it's about saving a Wordfile:
Sub M_snb()
msgbox ActiveWorkbook.FullName
msgbox activeWorkbook.path & "\" & label113.caption & textbox2.text & ".doc"
End Sub

[white_flag]

guys ...thx for the code ...
I didn't check VBA Express lately (too much stuff too do):

Yes I was trying to save from excel to word:
my entire code is like this:


Option Explicit
Sub makeFile()

Dim newFileName As String, strPath As String
Dim strFileName As String, strExt As String
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document

If ThisWorkbook.Name = ActiveWorkbook.Name Then
strPath = ThisWorkbook.Path & "\"
Else
strPath = ActiveWorkbook.Path & "\"
End If
strFileName = UserForm5.Label113.Caption & UserForm5.TextBox2.Text 'Change to suit
strExt = ".doc"
newFileName = strFileName & "-" & GetNewSuffix(strPath, strFileName, strExt) & strExt
MsgBox "The new FileName is: " & newFileName

Set wrdApp = CreateObject("Word.Application")
wrdApp.Visible = True
Set wrdDoc = wrdApp.Documents.Add
Application.DisplayAlerts = False
wrdDoc.SaveAs FileName:=strPath & newFileName
End Sub

Function GetNewSuffix(ByVal strPath As String, ByVal strName As String, ByVal strExt As String) As Integer
Dim strFile As String, strSuffix As String, intMax As Integer
On Error GoTo ErrorHandler
'File's name
strFile = Dir(strPath & "\" & strName & "*")
Do While strFile <> ""
'File's suffix starts 2 chars after 'root' name (right after the "-")
strSuffix = Mid(strFile, Len(strName) + 2, Len(strFile) - Len(strName) - Len(strExt) - 1)
'FileName is valid if 1st char after name is "-" and suffix is numeric with no dec point
'Skip file if "." or "," exists in suffix
If Mid(strFile, Len(strName) + 1, 1) = "-" And CSng(strSuffix) >= 0 And _
InStr(1, strSuffix, ",") = 0 And InStr(1, strSuffix, ".") = 0 Then
'Store the max suffix
If CInt(strSuffix) >= intMax Then intMax = CInt(strSuffix)
End If
NextFile:
strFile = Dir
Loop
GetNewSuffix = intMax + 1
Exit Function

ErrorHandler:
If Err Then
Err.Clear
Resume NextFile
End If
End Function

Function myDocument() As String
Dim strFileName As String, strExt As String, strPath As String

If ThisWorkbook.Name = ActiveWorkbook.Name Then
strPath = ThisWorkbook.Path & "\"
strFileName = UserForm5.Label113.Caption & UserForm5.TextBox2.Text 'Change to suit
strExt = ".doc"
myDocument = strFileName & "-" & GetNewSuffix(strPath, strFileName, strExt) - 1 & strExt
myDocument = ThisWorkbook.Path & "\" & myDocument
Else
strPath = ActiveWorkbook.Path & "\"
strFileName = UserForm5.Label113.Caption & UserForm5.TextBox2.Text 'Change to suit
strExt = ".doc"
myDocument = strFileName & "-" & GetNewSuffix(strPath, strFileName, strExt) - 1 & strExt
myDocument = ActiveWorkbook.Path & "\" & myDocument
End If

End Function


because I have a master excel. From that file are generated doc files (depends of the excel results)..and some time the activepath is not the same were the Thisworkbook.path is. Basically is taking the result table and puted in the doc file after code is chacking if the file name exist. But some time I have a revision of the file (there I used active.path). That was the logic.

For me the code is going. but I am not thinking as an programmer so it is possible a better approach?

[snb]

If you want
- to save a new Word document
- in the same directory of the active workbook
- which name is determined by label113.caption and textbox2.text
- and with a serial number 1 higher than the last document that has been saved under that name,
- while that serial number is preceded by a hyphen -

the only code you need

Sub M_snb()
c00=ActiveWorkbook.path & "\" & label113.caption & textbox2.text
c01=val(split(split(createobject("wscript.shell").exe("cmd /c dir " & c00 & "*.doc /b /o-d").stdout.readall),vbcrlf)(0),"-")(1))+1
with createobject("Word.Document")
.saveas c00 & "-" & c01 & ".doc"
end with
End Sub




NB. the most recent file that has been saved has the highest serial number. So the code is looking for the most recent file that matches the filename, the serialnumber excluded.

[white_flag]

Hi, snb

Your code is giving me: Compile error, highlighting Val then:
Wrong number of arguments or invalid property assignment

[snb]

Debugging is the fastest way to learn VBA...


Sub M_snb()
c00 = ActiveWorkbook.Path & "\" & label113.Caption & textbox2.Text
c01 = Format(Val(Split(Split(CreateObject("wscript.shell").exec("cmd /c dir " & c00 & "*.doc /b /o-d").stdout.readall, vbCrLf)(0), "-")(1)) + 1, " - 00")

With CreateObject("Word.Document")
.SaveAs c00 & c01 & ".doc"
.Close
End With
End Sub

[white_flag]

Debugging is the fastest way to learn VBA...


First I am doing that but ...

now (After I try to figure out what is wrong...)
I have error 9 (Script out of range).
because my dir is ..c:/my Files ?

[snb]

In post http://vbaexpress.com/forum/showpost.php?p=287536&postcount=9

I summed up the assumptions of the code.
If the activeworkbook.path isn't the folder in which the Wordfiles reside you have to adapt the code.

If there's no Word file that meets the criteria the code won't work: at least there must be 1 file named xxx - 05.doc

[white_flag]

still if I use on cmd:

C:\>dir c:\this is my directory\*.doc /b /o-d
The system cannot find the file specified.

C:\>dir c:\this is my directory\*.* /b /o-d
The system cannot find the file specified.

if you have "space" on path dir command will return an error

[snb]

So: avoid foldernames containing spaces...

[white_flag]

eh ... some times, were the revised file stays, are a lot of spaces.
for the moment I can live with what I have

still your code is very clever (thx for that).

[Kenneth Hobs]

You should use the VBA method DIR() to determine if a file or folder exists before taking some shell action.

When using a shell method, you may need to encapsulate some strings in quotes. e.g.
Sub Test1()
Dim myFile As String
myFile = Quote("w:\Kenneth Hobson.pdf")
'myFile = "w:\Kenneth Hobson.pdf"
Shell "CMD /k " & myFile
End Sub

Function Quote(str As String) As String
If Left(str, 1) = """" Then
Quote = str
Else: Quote = """" & str & """"
End If
End Function

[white_flag]

Kenneth, thank you very much :)

[snb]

So:


Sub M_snb()
c00 = ActiveWorkbook.Path & "\" & label113.Caption & textbox2.Text
c01 = Format(Val(Split(Split(CreateObject("wscript.shell").exec("cmd /c dir " & chr(34) & c00 & "*.doc" & chr(34) & " /b /o-d").stdout.readall, vbCrLf)(0), "-")(1)) + 1, " - 00")

With CreateObject("Word.Document")
.SaveAs c00 & c01 & ".doc"
.Close
End With
End Sub

[white_flag]

Hi, snb
This is cool (I think this is the shortest code ever (for this problem))..thx.
Like this it proves that my VBA skills are far away to low :)))
mvg, A.