Converting one XL sheet to .doc file

[kklaus]

Hi,

I need help converting one sheet in excel to a .doc file. I've created a letter in Excel that contains our company logo and the text of the letter. I was trying to copy the first 6 rows of the letter as a "picture" in word (that's where the logo is). Then paste the remaining rows as text in the word doc. I think it's crapping out at the part where I'm trying to get to the end of the document to make the 2nd paste. If I do not do this then when I do the second paste it overtypes the company logo with the text.

Please help.
Thanks!

Private Sub CommandButton1_Click()
Sub Export_Word_Attach_Outlook()
Dim source As Range
Dim wdApp As Object
Dim wdDoc As Object
Dim strdate As String
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

'Create a hidden instance of Word
Set wdApp = CreateObject("Word.Application")
'Add a document.
Set wdDoc = wdApp.Documents.Add
  
With ActiveSheet
Set source = .Range("A1:F6").SpecialCells(xlCellTypeVisible)
source.Copy
End With

'Here's where I tried to name the .doc file from a cell on the sheet
strname = ThisWorkbook.Sheets("Quote Letter").Range("F10").Value & " Quote Letter"

With wdDoc
wdDoc.PageSetup.LeftMargin = "0.5"
wdDoc.PageSetup.RightMargin = "0.5"
wdDoc.PageSetup.TopMargin = "0.5"
wdDoc.PageSetup.BottomMargin = "0.5"
'Paste the source-range into the active document as a picture
.Range.PasteSpecial Link:=False, DataType:=3, _
Placement:=0, DisplayAsIcon:=False
End With


With ActiveSheet
Set source = .Range("A7:F268").SpecialCells(xlCellTypeVisible)
source.Copy
End With

With wdDoc
'Paste the source-range into the active document
'I'm trying move to end of document so I don't paste over what I just copied above
'(Cells A1:F6).  I think it doesn't like this part

Selection.MoveDown Unit:=wdScreen, Count:=1
.Range.PasteSpecial Link:=False, DataType:=2, _
Placement:=0, DisplayAsIcon:=False

'Selection.Font.Name = "Arial"
'Selection.Font.Size = 10
End With
    
With wdDoc
'Save & Close the document
.SaveAs ThisWorkbook.Path & "\" & strname & ".doc"
.Close
End With


'Close the hidden instance of Word
wdApp.Quit

Application.CutCopyMode = False

strbody = "Enter Text Here"

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = ThisWorkbook.Sheets("Quote Letter").Range("B16").Value
.Subject = "Quote for " & ThisWorkbook.Sheets("Quote Letter").Range("F10").Value
.Body = strbody
.Attachments.Add ThisWorkbook.Path & "\" & strname & ".doc"
.Display
End With

'Release objects from memory.
Set wdDoc = Nothing
Set wdApp = Nothing
Set OutMail = Nothing
Set OutApp = Nothing

'Delete the Word-document.
Kill ThisWorkbook.Path & "\" & strname & ".doc"


End Sub

 

[macropod]

Hmm,

Perhaps something like:

With Selection
.EndKey Unit:=wdStory
.InsertAfter source
End With

Cheers

 

[kklaus]

Thanks for the reply! Here's the message that I'm getting when I run it:

"Object doesn't support this property or method"

Here's my updated code:

Private Sub CommandButton1_Click()
Sub Export_Word_Attach_Outlook()
Dim source As Range
Dim wdApp As Object
Dim wdDoc As Object
Dim strdate As String
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String

'Create a hidden instance of Word
Set wdApp = CreateObject("Word.Application")
'Add a document.
Set wdDoc = wdApp.Documents.Add
  
With ActiveSheet
Set source = .Range("A1:F6").SpecialCells(xlCellTypeVisible)
source.Copy
End With

'Here's where I tried to name the .doc file from a cell on the sheet
strname = ThisWorkbook.Sheets("Quote Letter").Range("F10").Value & " Quote Letter"

With wdDoc
wdDoc.PageSetup.LeftMargin = "0.5"
wdDoc.PageSetup.RightMargin = "0.5"
wdDoc.PageSetup.TopMargin = "0.5"
wdDoc.PageSetup.BottomMargin = "0.5"
'Paste the source-range into the active document as a picture
.Range.PasteSpecial Link:=False, DataType:=3, _
Placement:=0, DisplayAsIcon:=False
End With


With ActiveSheet
Set source = .Range("A7:F268").SpecialCells(xlCellTypeVisible)
source.Copy
End With

With wdDoc
'Paste the source-range into the active document
'I'm trying move to end of document so I don't paste over what I just copied above
'(Cells A1:F6).  I think it doesn't like this part

With Selection
    .EndKey Unit:=wdStory
    .InsertAfter source
End With

'Selection.MoveDown Unit:=wdScreen, Count:=1
.Range.PasteSpecial Link:=False, DataType:=2, _
Placement:=0, DisplayAsIcon:=False

'Selection.Font.Name = "Arial"
'Selection.Font.Size = 10
End With
    
With wdDoc
'Save & Close the document
.SaveAs ThisWorkbook.Path & "\" & strname & ".doc"
.Close
End With


'Close the hidden instance of Word
wdApp.Quit

Application.CutCopyMode = False

strbody = "Enter Text Here"

Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
With OutMail
.to = ThisWorkbook.Sheets("Quote Letter").Range("B16").Value
.Subject = "Quote for " & ThisWorkbook.Sheets("Quote Letter").Range("F10").Value
.Body = strbody
.Attachments.Add ThisWorkbook.Path & "\" & strname & ".doc"
.Display
End With

'Release objects from memory.
Set wdDoc = Nothing
Set wdApp = Nothing
Set OutMail = Nothing
Set OutApp = Nothing

'Delete the Word-document.
Kill ThisWorkbook.Path & "\" & strname & ".doc"

End Sub

 

[macropod]

OK, which line is highlighted when you get the "Object doesn't support this property or method" message? If it's the '.InsertAfter source' line, how about something like:

With Selection
.EndKey Unit:=wdStory
.PasteSpecial Link:=False, DataType:=wdPasteText
End With

Note that I've used DataType:=wdPasteText. If plain text isn't what you're after, you could substitute the '2' from your code.

Cheers