Problems with Save As

[riduwanz]

Hi Everyone,

I hope to get some help with the codes below. There are some other codes that pass Excel filename value to this macro. The intention is to use the same filename (without the extension .xls) as the name of the Word file.

The error is during the Save As...it says invalid file name (I think it is due to the .XLS extension) Anybody can kindly advise?

Sub SaveNewWordFile(ByVal fileNameWord As String)
    Dim appWord As Object
    Dim fileWord As Object
    Dim newWord As String
    newWord = ThisWorkbook.Path & fileNameWord
    Set appWord = CreateObject("Word.Application")
    appWord.Visible = True
    Set fileWord = appWord.Documents.Add
    appWord.Selection.Paste
    With wordFile
        .SaveAs newWord
        .Close
    End With
Set fileWord = Nothing
    Set appWord = Nothing
End Sub

Thanks in advance.
Rid

[mdmackillop]

Try the following:

Option Compare Text
 
Sub TestSave()
SaveNewWordFile "TestSave2.xls"
End Sub
 
Sub SaveNewWordFile(ByVal FileNameWord As String)
Dim appWord As Object
Dim fileWord As Object
Dim newWord As String
'Strip/add extension
If Right(FileNameWord, 4) = ".xls" Then
FileNameWord = Left(FileNameWord, Len(FileNameWord) - 4) & ".doc"
Else
FileNameWord = FileNameWord & ".doc"
End If
newWord = ThisWorkbook.Path & "\" & FileNameWord  '\ missing here
Set appWord = CreateObject("Word.Application")
appWord.Visible = True
Set fileWord = appWord.Documents.Add
appWord.Selection.Paste
With fileWord                    'typo on this line
.SaveAs newWord
.Close
End With
'debug
If Dir(newWord) <> "" Then MsgBox newWord & " saved"
Set fileWord = Nothing
Set appWord = Nothing
End Sub