PDA

View Full Version : [SOLVED:] Trouble getting word docs to print from Excel VBA


jmutsche
09-08-2014, 09:33 AM
Hey guys,

here is my code


Sub make_letters()

Dim wordoc As Word.Application, doc As Word.Document
Dim spath As String, i As Integer, oheaders As Range, bprint As Boolean
Set wordoc = CreateObject("Word.Application")
Sheets(1).Select
lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
mval = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row - 1
For x = 2 To lr
Cells(x, 3).Select
md = Selection.Value
Cells(x, 4).Select
add1 = Selection.Value
Cells(x, 5).Select
If Selection.Value = "NULL" Then
add2 = ""
Else
add2 = Selection.Value
End If

Cells(x, 6).Select
City = Selection.Value
Cells(x, 7).Select
State = Selection.Value
State = UCase(State)
Cells(x, 8).Select
zip = Selection.Value
Cells(x, 9).Select
phone = Selection.Value
Cells(x, 10).Select
fax = Selection.Value
Cells(x, 11).Select
iw = Selection.Value
Cells(x, 12).Select
dob = Selection.Value
Cells(x, 13).Select
claim = Selection.Value
Cells(x, 14).Select
DOI = Selection.Value
Cells(x, 15).Select
inc = Selection.Value
Cells(x, 16).Select
adjust = Selection.Value
Cells(x, 17).Select
comp = Selection.Value
Cells(x, 18).Select
Email = Selection.Value

'/////////////////////////////////////////////////////////////////////////////////////////////////
Cells(x, 23).Select
drug = Selection.Value
'////////////////////////////////////////////////////////////
Set oheaders = Range("a1").CurrentRegion.Rows(1)
spath = ThisWorkbook.FullName

Set wordoc = CreateObject("Word.Application")
wordoc.Visible = True
wordoc.Activate
'Set doc = Wordoc.Documents.Add
Set doc = wordoc.Documents.Open("G:\Staff\James Mutscheller\GO Letter SOF.docx") '<<< this will change when we get the right letterhead
'Set appWord = GetObject(, "word.application")
'If Err Then
' Shell "c:\Program Files\Microsoft Office\Office\" _
' & "Winword /Automation", vbHide
' AppActivate "Microsoft Word"
'AppActivate "Microsoft Word"
'End If
'On Error GoTo 0

With wordoc
.Selection.Goto what:=-1, Name:="docinfo"
.Selection.InsertAfter Date & vbCr & vbCr
.Selection.InsertAfter md & vbCr
.Selection.InsertAfter add1 & " " & add2 & vbCr
.Selection.InsertAfter City & " " & State & " " & zip & vbCr

If phone = "null" Or phone = "" Or phone = "--" Or phone = "Nul-l-Null" Then
'do nothing
Else
.Selection.InsertAfter "Phone: " & phone & vbCr
End If


If fax = "null" Or fax = "" Or fax = "--" Or fax = "Nul-l-Null" Then
'do nothing
Else
.Selection.InsertAfter "Fax: " & fax & vbCr
End If
.Selection.InsertAfter vbCr

.Selection.InsertAfter "RE: " & Chr(9) & iw & vbCr
.Selection.InsertAfter "DOB: " & Chr(9) & dob & vbCr
.Selection.InsertAfter "Claim#: " & Chr(9) & claim & vbCr
.Selection.InsertAfter "Date of injury: " & Chr(9) & DOI & vbCr
.Selection.InsertAfter "Injury description: " & inc & vbCr & vbCr
.Selection.InsertAfter "Dear Dr. " & md & "," & vbCr & vbCr
.Selection.InsertAfter "On behalf of State of Florida, Division of Risk Management, Progressive Medical, Inc. is administering the medication services for your patient's lower back strain. To assist in determining the medical necessity of the prescribed medication requested, please complete the following information and fax back to: 888-123-4567 by " & Format(Date + 30, "Mmmm") & " 1st" & vbCr & vbCr
.Selection.Goto what:=-1, Name:="drug"
.Selection.InsertAfter drug
End With





doc.SaveAs Filename:= _
"G:\Staff\James Mutscheller\Adjusters Folder\" & adjust & "\" & iw & md & adjust & ".docx"




wordoc.Application.PrintOut






doc.Close



wordoc.Quit wdDoNotSaveChanges





Next x


End Sub




I can't get these to print. It will if I step through the code, but not if I just run the macro. Can anyone give me a clue on what I am doing wrong? do I need to loop until the printer is ready or something? Please help I am so frustrated.
westconn1
09-08-2014, 02:23 PM
try doevents before printout
jmutsche
09-08-2014, 03:11 PM
try doevents before printout

I am no longer at work but I will try that first thing tomorrow.

Thanks,
jmutsche
09-08-2014, 03:21 PM
I wanted to try that before, but do i need to say

do
doevents
wordoc.Application.PrintOut
loop until ' some piece of code here that says printer is ready??? If so does anybody know what that piece of code would be?



thanks again guys.
westconn1
09-09-2014, 02:56 AM
try like

doc.SaveAs Filename:= _
"G:\Staff\James Mutscheller\Adjusters Folder\" & adjust & "\" & iw & md & adjust & ".docx"
doevents
wordoc.Application.PrintOut

or even try printing before saving


also you should create the worddoc object before you loop starts, then leave it open until after the loop finishes
this will improve speed and reduce resources used
open and close the documents only, within the loop, no need to activate wordoc
snb
09-09-2014, 04:21 AM
Are you familiar with mailmerge in Word ?
Just follow 1 lesson and this whole code will be redundant.
jmutsche
09-09-2014, 05:13 AM
I am familiar with it, but trying to batch these into individual folders, and email them at the end. this is just the letter creation piece. it is a large project, and creating this will be utilized for many different letters. it is a pretty nice tool. initially I tried to program the mailmerge but that is some tricky coding. This way works great. I just now want to print these and I am good. No point in going the other route at this point.
jmutsche
09-09-2014, 06:13 AM
This works now




Sub make_letters()

Dim wordoc As Word.Application, doc As Word.Document
Dim spath As String, i As Integer, oheaders As Range, bprint As Boolean
Set wordoc = CreateObject("Word.Application")
Sheets(1).Select
lr = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
mval = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row - 1
For x = 2 To lr
Cells(x, 3).Select
md = Selection.Value
Cells(x, 4).Select
add1 = Selection.Value
Cells(x, 5).Select
If Selection.Value = "NULL" Then
add2 = ""
Else
add2 = Selection.Value
End If

Cells(x, 6).Select
City = Selection.Value
Cells(x, 7).Select
State = Selection.Value
State = UCase(State)
Cells(x, 8).Select
zip = Selection.Value
Cells(x, 9).Select
phone = Selection.Value
Cells(x, 10).Select
fax = Selection.Value
Cells(x, 11).Select
iw = Selection.Value
Cells(x, 12).Select
dob = Selection.Value
Cells(x, 13).Select
claim = Selection.Value
Cells(x, 14).Select
DOI = Selection.Value
Cells(x, 15).Select
inc = Selection.Value
Cells(x, 16).Select
adjust = Selection.Value
Cells(x, 17).Select
comp = Selection.Value
Cells(x, 18).Select
Email = Selection.Value

'/////////////////////////////////////////////////////////////////////////////////////////////////
Cells(x, 23).Select
drug = Selection.Value
'////////////////////////////////////////////////////////////
Set oheaders = Range("a1").CurrentRegion.Rows(1)
spath = ThisWorkbook.FullName

Set wordoc = CreateObject("Word.Application")
wordoc.Visible = True
wordoc.Activate
'Set doc = Wordoc.Documents.Add
Set doc = wordoc.Documents.Open("G:\Staff\James Mutscheller\GO Letter SOF.docx") '<<< this will change when we get the right letterhead
'Set appWord = GetObject(, "word.application")
'If Err Then
' Shell "c:\Program Files\Microsoft Office\Office\" _
' & "Winword /Automation", vbHide
' AppActivate "Microsoft Word"
'AppActivate "Microsoft Word"
'End If
'On Error GoTo 0

With wordoc
.Selection.Goto what:=-1, Name:="docinfo"
.Selection.InsertAfter Date & vbCr & vbCr
.Selection.InsertAfter md & vbCr
.Selection.InsertAfter add1 & " " & add2 & vbCr
.Selection.InsertAfter City & " " & State & " " & zip & vbCr

If phone = "null" Or phone = "" Or phone = "--" Or phone = "Nul-l-Null" Then
'do nothing
Else
.Selection.InsertAfter "Phone: " & phone & vbCr
End If


If fax = "null" Or fax = "" Or fax = "--" Or fax = "Nul-l-Null" Then
'do nothing
Else
.Selection.InsertAfter "Fax: " & fax & vbCr
End If
.Selection.InsertAfter vbCr

.Selection.InsertAfter "RE: " & Chr(9) & iw & vbCr
.Selection.InsertAfter "DOB: " & Chr(9) & dob & vbCr
.Selection.InsertAfter "Claim#: " & Chr(9) & claim & vbCr
.Selection.InsertAfter "Date of injury: " & Chr(9) & DOI & vbCr
.Selection.InsertAfter "Injury description: " & inc & vbCr & vbCr
.Selection.InsertAfter "Dear Dr. " & md & "," & vbCr & vbCr
.Selection.InsertAfter "On behalf of State of Florida, Division of Risk Management, HELIOS is administering the medication services for your patient's lower back strain. To assist in determining the medical necessity of the prescribed medication requested, please complete the following information and fax back to: 888-245-5248 by " & vbCr & vbCr
.Selection.Goto what:=-1, Name:="drug"
.Selection.InsertAfter drug
End With



Do
DoEvents
wordoc.Application.PrintOut
Loop Until Application.Wait(Now + #12:00:03 AM#)


doc.SaveAs Filename:= _
"G:\Staff\James Mutscheller\Adjusters Folder\" & adjust & "\" & iw & md & adjust & ".docx"










wordoc.Quit wdDoNotSaveChanges





Next x


End Sub



Thanks everyone