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.
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.