Excel/Question Again



yeah i tried both of those methods, send and call, neither one worked, but with that code it prints all those active accounts to say the desktop and names them individually.  Just cant figure out how to or what to do to enable it to create individual emails for each active client and send their monthly statement....have tried numerous ways....any other suggestions?



--- I have revised my answer - had to add a line of code to close the new workbook in the first routine and the same in the second routine ----------

I have modified your code to use the approach I laid out in my previous answer.  See if this works for you.  (I am not able to test it so you may have to do a few fixes.)

Option Private Module

Sub PrintMasterInvoice()

Application.ScreenUpdating = False

Dim ce As Range, i As Long, strPath As String
Dim bk1 As Workbook, bk2 As Workbook
Dim Sh1 As Worksheet, sh2 As Worksheet, Sh3 As Worksheet

Dim r1 As Range, r2 As Range, r3 As Range, r4 As Range, r5 As Range, r6 As Range, r7 As Range
Dim r8 As Range, r9 As Range, r10 As Range, r11 As Range, r12 As Range, r13 As Range, r14 As Range
Dim r15 As Range, r16 As Range, r17 As Range, r18 As Range, r19 As Range, r20 As Range, r21 As Range
Dim r22 As Range, r23 As Range, r24 As Range, r25 As Range

Dim s1 As Range, s2 As Range, s3 As Range, s4 As Range, s5 As Range, s6 As Range, s7 As Range
Dim s8 As Range, s9 As Range, s10 As Range, s11 As Range, s12 As Range, s13 As Range, s14 As Range
Dim s15 As Range, s16 As Range, s17 As Range, s18 As Range, s19 As Range, s20 As Range, s21 As Range
Dim s22 As Range, s23 As Range, s24 As Range, s25 As Range

Set bk1 = ThisWorkbook
Workbooks.Add Template:=xlWBATWorksheet
Set bk3 = ActiveWorkbook
Set Sh3 = bk3.Worksheets(1)
bk1.Sheets("pymtlog").Visible = True
bk1.Sheets("monthlystatement1").Visible = True

' define your sheets outside the loop
Set Sh1 = bk1.Worksheets("pymtlog") '<== Moved
Set sh2 = bk1.Worksheets("monthlystatement1") '<== Moved
lOrders = Sh1.Range("C3").Value
' you find the bottom of your data using row M

For i = 8 To Sh1.Range("B65536").End(xlUp).Row

' but your check for your value in column "I"
' if that is correct OK. But if you want to check in ' column M change your 9 to "M" or 13

If ((Sh1.Cells(i, 2).Value = Sh1.Range("A3"))) Then

Set r1 = Sh1.Cells(i, "E") 'Account #
Set r2 = Sh1.Cells(i, "D") 'Name
Set r3 = Sh1.Cells(i, "Z") 'Address
Set r4 = Sh1.Cells(i, "ASE") ' City, St Zip
Set r5 = Sh1.Cells(i, "O") ' Home #
Set r6 = Sh1.Cells(i, "M") ' Cell #
Set r7 = Sh1.Cells(i, "P") ' Email Addy
Set r8 = Sh1.Cells(i, "AE") ' Date Closed
Set r9 = Sh1.Cells(i, "AK") ' Payment
Set r10 = Sh1.Cells(i, "AJ") ' Terms
Set r11 = Sh1.Cells(i, "AI") ' Rate
Set r12 = Sh1.Cells(i, "AL") ' 1st Pymt
Set r13 = Sh1.Cells(i, "ASD") ' Balance
Set r14 = Sh1.Cells(i, "ASF") ' Last Paid

Set r15 = Sh1.Cells(i, "ASG") ' Amt Paid
Set r16 = Sh1.Cells(i, "ASH") ' Months Left
Set r17 = Sh1.Cells(i, "AQ") ' Year
Set r18 = Sh1.Cells(i, "AP") ' Make
Set r19 = Sh1.Cells(i, "AS") ' Serial Number

Set r20 = Sh1.Cells(i, "ASJ") ' Applied to Interest
Set r21 = Sh1.Cells(i, "ASK") ' Applied to Principal
Set r22 = Sh1.Cells(i, "ASD") ' Current Balance
Set r23 = Sh1.Cells(i, "ASI") ' Next Date Due
Set r24 = Sh1.Cells(i, "AK") ' Amount Due
Set r25 = Sh1.Cells(i, "ASL") ' Months Past Due

Set s1 = sh2.Range("M1") 'Account #
Set s2 = sh2.Range("M2") 'Name
Set s3 = sh2.Range("M3") 'Address
Set s4 = sh2.Range("M4") ' City, St Zip
Set s5 = sh2.Range("M5") ' Home #
Set s6 = sh2.Range("M6") ' Cell #
Set s7 = sh2.Range("M7") ' Email Addy
Set s8 = sh2.Range("M8") ' Date Closed
Set s9 = sh2.Range("M9") ' Payment
Set s10 = sh2.Range("M10") ' Terms
Set s11 = sh2.Range("M11") ' Rate
Set s12 = sh2.Range("M12") ' 1st Pymt
Set s13 = sh2.Range("M13") ' Balance
Set s14 = sh2.Range("O1") ' Last Paid

Set s15 = sh2.Range("O2") ' Amt Paid
Set s16 = sh2.Range("O3") ' Months Left
Set s17 = sh2.Range("O4") ' Year
Set s18 = sh2.Range("O5") ' Make
Set s19 = sh2.Range("O6") ' Serial Number

Set s20 = sh2.Range("O7") ' Applied to Interest
Set s21 = sh2.Range("O8") ' Applied to Principal
Set s22 = sh2.Range("O9") ' Current Balance
Set s23 = sh2.Range("O10") ' Next Date Due
Set s24 = sh2.Range("O11") ' Amount Due
Set s25 = sh2.Range("O14") ' Months Past Due

s1.Value = r1.Value
s2.Value = r2.Value
s3.Value = r3.Value
s4.Value = r4.Value
s5.Value = r5.Value
s6.Value = r6.Value
s7.Value = r7.Value
s8.Value = r8.Value
s9.Value = r9.Value

s10.Value = r10.Value
s11.Value = r11.Value
s12.Value = r12.Value
s13.Value = r13.Value
s14.Value = r14.Value

s15.Value = r15.Value
s16.Value = r16.Value
s17.Value = r17.Value
s18.Value = r18.Value
s19.Value = r19.Value
s20.Value = r20.Value
s21.Value = r21.Value
s22.Value = r22.Value
s23.Value = r23.Value
s24.Value = r24.Value
s25.Value = r25.Value

'ChDir "C:UsersAnthonyDesktop"
'Sh2.ExportAsFixedFormat Type:=xlTypePDF, Quality:=xlQualityStandard

' since I reference sh2 directly, I don't have ' to hide sh1 and then show it again sh2.Printout

'ActiveWindow.SelectedSheets.PrintOut Copies:=1, ActivePrinter:=strPDFprinter, Collate:=-True

sh2.Copy After:=bk3.Worksheets(bk3.Worksheets.Count)

End If

Next i '<== added command
sh2.Visible = xlSheetHidden
Set Sh1 = Nothing
Set sh2 = Nothing
strPath = Environ$("temp") & "\" 'Or any other path, but include trailing "\"
Application.DisplayAlerts = False
Application.DisplayAlerts = True
On Error Resume Next
 Kill strPath & "MultipleSheets.xlsx"
On Error GoTo 0
bk3.SaveAs Filename:=strPath & "MultipleSheets.xlsx", FileFormat:=xlOpenXMLWorkbook
bk3.Close Savechanges:=False

MsgBox " Total of " & lOrders & " Monthly Statements" & vbNewLine & _
" Were Successfully Prepared and Copied"

' call routine to prepare and send out PDF attachment


Worksheets("monthlystatement1").Visible = xlSheetVeryHidden

Application.ScreenUpdating = True

End Sub

Sub Sendmonthlystatement1()
' Create PDF of active sheet and send as attachment.

Sheets("monthlystatement1").Visible = True
Worksheets("pymtlog").Visible = xlSheetVeryHidden

Dim Sh1 As Worksheet
Dim strPath As String, strFName As String
Dim OutApp As Object, OutMail As Object
Dim bk1 As Workbook, bk2 As Workbook
Dim sh2 As Worksheet

Set bk1 = ThisWorkbook

'Create PDF of active sheet only
strPath = Environ$("temp") & "\" 'Or any other path, but include trailing "\"
Workbook.Open strPath & "MultipleSheets.xlsx"
Set bk2 = Workbooks("Multiplesheets.xlsx")

'Set up outlook
Set OutApp = CreateObject("Outlook.Application")
For Each sh2 In bk2.Worksheets
Set Sh1 = sh2
strFName = Sh1.Range("D10")
strFName = "Monthly Statement" & " - " & "" & ".pdf"
strEname = Sh1.Range("D14")
strOName = Sh1.Range("G20")
strOCName = Sh1.Range("B1")
strCCName = Sh1.Range("A14")
On Error Resume Next
  Kill strPath & strFName
On Error GoTo 0

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
strPath & strFName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Set OutMail = OutApp.CreateItem(0)
'Create message
On Error Resume Next

With OutMail
.To = strEname 'Insert required address here ########
.CC = strCCName
.BCC = ""
.Subject = "Monthly Statement"
.Body = vbNewLine & vbNewLine & _
"Attached is your Monthly Statement for your review." & vbNewLine & vbNewLine & _
"If you have any question feel free to call. " & vbNewLine & vbNewLine & _
"Thanks!" & vbNewLine & vbNewLine & _
"Management" & vbNewLine '& _
'strOCName & vbNewLine
.Attachments.Add strPath & strFName
.Display 'Use only during debugging ##############################
'.Send 'Uncomment to send e-mail ##############################
End With
'Delete any temp files created
Kill strPath & strFName
On Error GoTo 0
Set OutMail = Nothing
Next sh2

Set OutApp = Nothing

bk2.close SaveChanges:=False

Sheets("pymtrecpt").Visible = True
'Worksheets("pymtlog").Visible = xlSheetVeryHidden

Application.ScreenUpdating = True

End Sub

Tom Ogilvy

---------- FOLLOW-UP ----------

QUESTION: ok i will try this ...also is there a way the below code can be changed to have it create a specific folder on the desktop opposed to already having it created..

'ChDir "C:\Users\Anthony\Desktop\Statements"

ChDir "C:\Users\Anthony\Desktop\" & strDName & "Statements"
'Sh2.ExportAsFixedFormat Type:=xlTypePDF, Quality:=xlQualityStandard

'strPath = Environ$("temp") & "\"
strFName = Sh2.Range("D10")
strDName = Sh2.Range("A10")'=month of statement

'Application.Run "Sendmonthlystatement1"

Sh2.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
       strDName & " Monthly Statement for " & strFName, Quality:=xlQualityStandard, _
       IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

notice i tried changing the chdir to have it create the month statement folder


will let you know if it worked



Say I have a folder


and I want to create a folder


then I would issue two commands

mkdir "C:\Folder1\SubFolder1"
mkdir "C:\Folder1\SubFolder1\SubFolder2"

then I can do

chdir "C:\Folder1\SubFolder1"


chdir "C:\Folder1\SubFolder1\SubFolder2"

even though I have used capitalization, capitalization is ignored - it is case insensitive.

You can only create a folder at the next level down.  In the example I wanted to eventually have a folder two levels down.  If you only need to go one level down, then you only need to "mkdir" once.

hope that information allows you to achieve what you want to do.

Tom Ogilvy

---------- FOLLOW-UP ----------

QUESTION: but those folders already have to be named, correct?
or do i have to create them both in the code and on the c:

what i was trying to do, is have it create the folder on the desktop automatically based on the month of the statement, and i had added that state looking at the A10 range which would have the month of the statement

does that make any sense, or is it even possible?


ps i also went ahead and sent you the program so you could have something to test....if you can run it with the macros, given i think you are using 2003....



You can't change to a folder that does not exist.

If it does not exist and you want to use it you have to create it.  

mkdir is used to create a folder
chdir is used to change to a folder and make it the default folder

Aspects particular to what you are doing I have no knowledge of.

Tom Ogilvy

About Excel
This topic answers questions related to Microsoft Excel spreadsheet (or workbook) stand-alone or Mircrosoft Office Excel including Excel 2003, Excel 2007, Office 2000, and Office XP. You can get Excel help on Excel formulas(or functions), Excell macros, charting in Excel, advanced features, and the general use of Excel. This does not provide a general Excel tutorial nor the basics of using a spreadsheet. It provides specific answers to using Microsoft Excel only. If you do not see your Excel question answered in this area then please ask an Excel question here


All Answers

Answers by Expert:

Ask Experts


Tom Ogilvy


Selected as an Excel MVP by Microsoft since 1999. Answering Excel questions in Allexperts since its inception in 2001. Able to answer questions on almost all aspects of Excel's internal capabilities. If seeking a VBA solution, please specify that in your question itself so I give you the answer you want. [Excel has weak protection - if you are distributing an application, I don't answer questions on how to protect your project from your users.]


Extensive experience.

Master of Science (MS) degree Operations Research (ORSA)

Awards and Honors
Microsoft MVP in Excel.

©2017 About.com. All rights reserved.