Excel sheet Saved as word doc using cell value

[Oreg]

Hello,

I am having trouble saving (naming) a new word doc dependant upon what a cell value is. The folder name where the word doc should be saved is also based on a certain cell value.

I keep receiving an error: Error number 438. There is a problem

Below is the code:


Thanks, Oreg

Option Explicit
Sub BCMerge()
Dim pappWord As Object
Dim docWord As Object
Dim wb As Excel.Workbook
Dim xlName As Excel.Name
'Dim TodayDate As String
Dim ActiveDocument As Object
Dim Path As String

Set wb = ActiveWorkbook

'TodayDate = Format(Date, "mmmm d, yyyy")
Path = wb.Path & "\MetroTemplate.dot"

On Error GoTo ErrorHandler
'Create a new Word Session
Set pappWord = CreateObject("Word.Application")

On Error GoTo ErrorHandler
'Open document in word
Set docWord = pappWord.Documents.Add(Path)

'Loop through names in the activeworkbook
For Each xlName In wb.Names
'if xlName's name is existing in document then put the value in place of the bookmark
If docWord.Bookmarks.Exists(xlName.Name) Then
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value)
End If
Next xlName

'Activate word and display document


ChDir "C:\Automated Metro\Metro PCI Cover Page\" & wb.Range("C5")
If Err.Number = 76 Then MkDir "C:\Automated Metro\Metro PCI Cover Page\" & wb.Range("C5")

pappWord.SaveAs Filename:="C:\Automated Metro\Metro PCI Cover Page\" & wb.Range("C5") & "\" & _
wb.Range("C5") & "_" & wb.Range("D7") & ".doc"

With pappWord

.Visible = True
.ActiveWindow.WindowState = 1
.Activate
End With
'Next
Application.DisplayAlerts = True

'Release the Word object to save memory and exit macro
ErrorExit:
Set pappWord = Nothing
Exit Sub
'Error Handling routine
ErrorHandler:
If Err Then
MsgBox "Error No: " & Err.Number & "; There is a problem"
If Not pappWord Is Nothing Then
pappWord.Quit False
End If
Resume ErrorExit
End If

With wb
Application.IgnoreRemoteRequests = False
wb.Close True
End With

End Sub

[Carim]

Hi,

What is wrong with your instruction ...

pappWord.SaveAs Filename

At which level, is there a bug ?

Carim

[Oreg]

Hi Carim,

Thanks so much for responding !! It seems to error when either making the folder or saving the word doc using cell values from Sheets("Metro"). When I take out the following lines from the code, everything works fine. My Excel Name Fields merge to the designated bookmarks and the Word doc opened is named document1. So it seems there is something wrong with the following lines below....I guess? But I'm not sure.

ChDir "C:\Automated Metro\Metro PCI Cover Page\" & wb.Range("C5")

If Err.Number = 76 Then MkDir "C:\Automated Metro\Metro PCI Cover Page\" & wb.Range("C5")

pappWord.SaveAs Filename:="C:\Automated Metro\Metro PCI Cover Page\" & wb.Range("C5") & "\" & _
wb.Range("C5") & "_" & wb.Range("D7") & ".doc"

Thanks,
Oreg

[Carim]

Well ...

First things first ... for a start the format ...

pappWord.SaveAs Filename:="C:\Automated Metro\Metro PCI Cover Page\" & wb.Range("C5") & "\" & _
wb.Range("C5") & "_" & wb.Range("D7") & ".xls"

HTH
Carim

[Oreg]

Hi Carim,

I made a little progress....

I changed wb.Range("C5") to Sheets("METRO").Range("C5").Value

Now the folder will be created if it doesn't exist, but I still can't save the word document into the created folder (if it didn't already exist). I keep getting the Error number 438... I tried what you posted with the same results but i think your code would save it as an excel spreadsheet...I am trying to save the word document.

Dim MyPath As String
MyPath = "C:\Automated Metro\Metro PCI Cover Page\" & Sheets("METRO").Range("C5").Value

On Error Resume Next
ChDir MyPath

If Err.Number = 76 Then MkDir "C:\Automated Metro\Metro PCI Cover Page\" & Sheets("METRO").Range("C5").Value


Still having problems with the code below... (by the way, I changed

pappWord.SaveAs Filename:="C:\Automated Metro\Metro PCI Cover Page\" & Sheets("METRO").Range("C5").Value & "\" & _
Sheets("METRO").Range("C5").Value & "_" & Sheets("METRO").Range("D7").Value & ".doc" _

Thanks,

Oreg

[Carim]

Oreg,

Can you actually from XL save in *.doc ...? not in my version at least ...

HTH
Carim

[Oreg]

Carim,

Just wanted to thank you again for your assistance. FYI, I found out what I needed to fix. Below is the code that pushes named ranges form an excel worksheet over to bookmarks on a Word doc, then saves the word doc as Sheets(Metro).Range("C5") .xls in a folder specified by a cell value on the spreadsheet (creating the folder if it doesn't already exist).

Thanks,

Oreg

Option Explicit
Sub BCMerge()
Dim pappWord As Object
Dim docWord As Object
Dim wb As Excel.Workbook
Dim xlName As Excel.Name
Dim ActiveDocument As Object
Dim Path As String
Dim MyPath As String

Set wb = ActiveWorkbook
MyPath = "C:\Automated Metro\Metro PCI Cover Page\" & Sheets("METRO").Range("C5").Value

Application.Visible = True

On Error Resume Next
ChDir MyPath
If Err.Number = 76 Then MkDir "C:\Automated Metro\Metro PCI Cover Page\" & Sheets("METRO").Range("C5").Value

Path = wb.Path & "\MetroTemplate.dot"

On Error GoTo ErrorHandler
'Create a new Word Session
Set pappWord = CreateObject("Word.Application")

On Error GoTo ErrorHandler
'Open document in word
Set docWord = pappWord.Documents.Add(Path)
'Loop through names in the activeworkbook
For Each xlName In wb.Names
'if xlName's name is existing in document then put the value in place of the bookmark
If docWord.Bookmarks.Exists(xlName.Name) Then
docWord.Bookmarks(xlName.Name).Range.Text = Range(xlName.Value)
End If

Next xlName

With pappWord

.Visible = True
.ActiveWindow.WindowState = 1
.Activate

End With

With docWord

.Activate
.SaveAs Filename:="C:\Automated Metro\Metro PCI Cover Page\" & Sheets("METRO").Range("C5").Value & "\" & _
Sheets("METRO").Range("C5").Value & "_" & Sheets("METRO").Range("D7").Value & ".doc"


End With

'Next
Application.DisplayAlerts = True

'Release the Word object to save memory and exit macro
ErrorExit:
Set pappWord = Nothing

Exit Sub

'Error Handling routine
ErrorHandler:
If Err Then
MsgBox "Error No: " & Err.Number & "; There is a problem"
If Not pappWord Is Nothing Then
pappWord.Quit False
End If
Resume ErrorExit

End If

With wb
Application.IgnoreRemoteRequests = False
wb.Close True
End With

End Sub

[Carim]

Hi Oreg,

If I may ...three comments :

1. Congratulations on your code which works great ... !!!
2. Love your attitude of initiative and perseverance
3. Thanks for the feedback

All the Best
Carim