Solved

Excel Macro to fill out two templates

Posted on 2009-04-14
21
709 Views
Last Modified: 2012-05-06
Hello,
An existing macro works well,it
I open up a excel file
The macro, opens a template , copies the required cells from the old spreadsheet, closes the old , opens a template, and copies the cells to the template. In the new spreadsheet, it also check to see what currency the spreadsheet is in and puts in different variables based upon the cuurency type, either CAD or USD. Then it prints and emails the file. Now I need to adjust it becuase I need it to open and populate another spreadsheet with the same data.  The other template is laid out differently with less columns and a formula to calcute a fee based upon the data from the old spreadsheet. The newer tempalte will be printed then emailed, then the older template will just be emailed. I thought if I just add in the new items it would work but can't fill in the variables.  

Sub newport_trades()

'

' newport_trades Macro

' Generate and send trade tickets for 

'

    Dim FileName As String

    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook

    Dim ws As Worksheet

    Dim T_Buy, T_DTC, T_Date, S_Date, T_Shares, S_Name, S_Number, T_Comm, T_Price, T_Curr, T_Total, T_Clients, T_Alloc

    Dim OutApp As Object

    Dim OutMail As Object

    Dim cell As Range

    

    FileName = InputBox("Enter Original File Name")

    

    Set wb1 = Workbooks.Open("C:\Documents and Settings\rsernowski\Desktop\" & FileName & ".xls")

    Set wb2 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\CITI Trade Advice.xlt")

    'this is the new template'

    Set wb3 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\NBCN Trade Advice.xlt")

    

    'copy required cells from original file'

    With wb1.Worksheets("Sheet1")

        T_Buy = .Cells(7, 3)

        T_DTC = .Cells(7, 4)

        T_Date = .Cells(7, 7)

        S_Date = .Cells(7, 8)

        T_Shares = .Cells(7, 9)

        S_Name = .Cells(7, 10)

        S_Number = .Cells(7, 11)

        T_Comm = .Cells(7, 13)

        T_Price = .Cells(7, 14)

        T_Curr = .Cells(7, 15)

        T_Total = .Cells(7, 16)

        End With

    wb1.Close

   'Fill out the new template and Print'

    With wb2.Worksheets("Sheet1")

        .Cells(4, 5) = T_Buy

        .Cells(4, 8) = T_Date

        .Cells(4, 9) = S_Date

        .Cells(4, 14) = T_Curr

        .Cells(4, 15) = T_Comm

        .Cells(4, 16) = S_Name

        .Cells(4, 17) = S_Number

        .Cells(4, 18) = T_Shares

        .Cells(4, 19) = T_Price

        .Cells(4, 22) = T_Total

        .Cells(4, 23) = T_DTC

 End With

    'Determine USD and CAD and fill out resepective areas'

Set wb2 = ActiveSheet

    If T_Curr = "CAD" Then

        Cells(4, 1) = "297Z01A"

        Cells(4, 3) = "29701BC"

        Cells(4, 4) = "TU"

    Else

        Cells(4, 1) = "297Z01B"

        Cells(4, 3) = "29701BD"

        Cells(4, 4) = "NU"

    End If

    End With

  'Fill out the older template and send

     With wb3.Worksheets("Sheet1")

        .Cells(3, 5) = T_Buy

        .Cells(3, 8) = T_Date

        .Cells(3, 9) = S_Date

        .Cells(3, 14) = T_Curr

        .Cells(3, 15) = T_Comm

        .Cells(4, 16) = S_Name

        .Cells(4, 17) = S_Number

        .Cells(4, 18) = T_Shares

        .Cells(4, 19) = T_Price

        .Cells(4, 22) = T_Total

        .Cells(4, 23) = T_DTC

        End With

    'Determine USD and CAD and fill out resepective areas'

    If T_Curr = "CAD" Then

        Cells(4, 1) = "297Z01A"

        Cells(4, 3) = "29701BC"

        Cells(4, 4) = "TU"

    Else

        Cells(4, 1) = "297Z01B"

        Cells(4, 3) = "29701BD"

        Cells(4, 4) = "NU"

    End If

 

 'print the newer template and save it

 Set wb2 = ActiveSheet

 wb2.PageSetup.Orientation = xlLandscape

 wb2.PageSetup.PaperSize = xlPaperLetter

 wb2.PageSetup.FitToPagesWide = 1

 wb2.PageSetup.FitToPagesTall = 1
 

ExecuteExcel4Macro "PRINT(1,,,1,,,,,,,,2,,,TRUE,,FALSE)"
 

wb2.SaveAs ("C:\Documents and Settings\rsernowski\Documents\" & FileName & ".xls")
 
 

If MsgBox("Click OK to EMail to Newport/Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub

  Set OutApp = CreateObject("Outlook.Application")

 OutApp.Session.Logon

 Set OutMail = OutApp.CreateItem(0)

 With wb2

   With OutMail

  .To = ""

  .CC = "rsernowski@gmail.com"

  .BCC = ""

 .Subject = ""

 .Body = ""

 .Attachments.Add wb2.FullName

 .Send   'or use .Display

 End With

 On Error GoTo 0

 wb2.Close SaveChanges:=False

 End With
 

 'send the document the older template

 Set wb3 = ActiveSheet

 If MsgBox("Click OK to EMail to Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub

 Set OutApp = CreateObject("Outlook.Application")

 OutApp.Session.Logon

 Set OutMail = OutApp.CreateItem(0)

 With wb3

    With OutMail

       .To = "mymailplace.ca"

              .CC = "rsernowski@gmail.com"

              .BCC = ""

            .Subject = ""

             .Body = ""

            .Attachments.Add wb3.FullName

            .Send   'or use .Display

        End With

        On Error GoTo 0

       wb3.Close SaveChanges:=False

     End With

  End Sub

Open in new window

0
Comment
Question by:rsernowski
  • 11
  • 10
21 Comments
 
LVL 18

Expert Comment

by:Curt Lindstrom
ID: 24158623
Hi Robert,

1. Can you explain a bit more what you mean with:
 "I thought if I just add in the new items it would work but can't fill in the variables."

2. You are changing the wb3 workbook variable at line 118 with "Set wb3 = ActiveSheet" This doesn't make sense to me. What are you trying to achieve with this line?

3. Can you describe what result you expected from your updated macro and what result you get.

Cheers,
Curt
0
 

Author Comment

by:rsernowski
ID: 24161619
Hi Curt,

I am working thru the code right now again.The set WB3 active was a trail.  In a nutshell, I have a imported file.(we call it orginal. It copies the data, close the original file, fills it out, prints it, then probably send it, then I guess close the wb2 , then fill out wb3 with the same data, then send it.
0
 

Author Comment

by:rsernowski
ID: 24161800
Ok I adjust the code a bit.  So really it is supposed to fill out the first template , then fill out the second one.  No sending or printing yet. It fills out wb3 correctly but doesn't fill out wb2 correctly, missing the if cell = USD then..
0
 
LVL 18

Expert Comment

by:Curt Lindstrom
ID: 24163639
You have the End With in the wrong places and you haven't got the full stop in front of the currency cells.

See snippet

Curt
    'Fill out the new template and Print'

    With wb2.Worksheets("Sheet1")

        .Cells(4, 5) = T_Buy

        .Cells(4, 8) = T_Date

        .Cells(4, 9) = S_Date

        .Cells(4, 14) = T_Curr

        .Cells(4, 15) = T_Comm

        .Cells(4, 16) = S_Name

        .Cells(4, 17) = S_Number

        .Cells(4, 18) = T_Shares

        .Cells(4, 19) = T_Price

        .Cells(4, 22) = T_Total

        .Cells(4, 23) = T_DTC

        'Determine USD and CAD and fill out resepective areas'

        Set wb2 = ActiveSheet

        If T_Curr = "CAD" Then

            .Cells(4, 1) = "297Z01A"

            .Cells(4, 3) = "29701BC"

            .Cells(4, 4) = "TU"

        Else

            .Cells(4, 1) = "297Z01B"

            .Cells(4, 3) = "29701BD"

            .Cells(4, 4) = "NU"

        End If

    End With

    'Fill out the older template and send

    With wb3.Worksheets("Sheet1")

        .Cells(3, 5) = T_Buy

        .Cells(3, 8) = T_Date

        .Cells(3, 9) = S_Date

        .Cells(3, 14) = T_Curr

        .Cells(3, 15) = T_Comm

        .Cells(4, 16) = S_Name

        .Cells(4, 17) = S_Number

        .Cells(4, 18) = T_Shares

        .Cells(4, 19) = T_Price

        .Cells(4, 22) = T_Total

        .Cells(4, 23) = T_DTC
 

        'Determine USD and CAD and fill out resepective areas'

        If T_Curr = "CAD" Then

            .Cells(4, 1) = "297Z01A"

            .Cells(4, 3) = "29701BC"

            .Cells(4, 4) = "TU"

        Else

            .Cells(4, 1) = "297Z01B"

            .Cells(4, 3) = "29701BD"

            .Cells(4, 4) = "NU"

        End If

    End With

Open in new window

0
 

Author Comment

by:rsernowski
ID: 24166750
Hi Curt ,

Ok it is working much better now, thanks One last question if you please, it is all working fairly good now.  But the macro is supposed to print it on letter landscape , fit to 1 page , but I get portrait, on 3 pages! Any help would be appreciated.

Thanks
Robert

Sub newport_trades()
'
' newport_trades Macro
' Generate and send trade tickets for Citi and NBCN
'
    Dim FileName As String
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook
    Dim ws As Worksheet
    Dim T_Buy, T_DTC, T_Date, S_Date, T_Shares, S_Name, S_Number, T_Comm, T_Price, T_Curr, T_Total
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
   
    FileName = InputBox("Enter Original File Name")
   
    Set wb1 = Workbooks.Open("C:\Documents and Settings\rsernowski\Desktop\" & FileName & ".xls")
    Set wb2 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\CITI Trade Advice.xlt")
   
    'Copy the orginal file
    With wb1.Worksheets("Sheet1")
        T_Buy = .Cells(7, 3)
        T_DTC = .Cells(7, 4)
        T_Date = .Cells(7, 7)
        S_Date = .Cells(7, 8)
        T_Shares = .Cells(7, 9)
        S_Name = .Cells(7, 10)
        S_Number = .Cells(7, 11)
        T_Comm = .Cells(7, 13)
        T_Price = .Cells(7, 14)
        T_Curr = .Cells(7, 15)
        T_Total = .Cells(7, 16)
    End With
    wb1.Close
   'Fill out CITI Trade Advice and Print'
    With wb2.Worksheets("Sheet1")
        .Cells(4, 5) = T_Buy
        .Cells(4, 8) = T_Date
        .Cells(4, 9) = S_Date
        .Cells(4, 14) = T_Curr
        .Cells(4, 15) = T_Comm
        .Cells(4, 17) = S_Name
        .Cells(4, 18) = S_Number
        .Cells(4, 19) = T_Shares
        .Cells(4, 20) = T_Price
        .Cells(4, 23) = T_Total
        .Cells(4, 24) = T_DTC
    End With
    'Determine USD and CAD and fill out resepective areas'
    If T_Curr = "CAD" Then
        Cells(4, 1) = "297Z01A"
        Cells(4, 3) = "29701BC"
        Cells(4, 4) = "TU"
        Else
        Cells(4, 1) = "297Z01B"
        Cells(4, 3) = "29701BD"
        Cells(4, 4) = "NU"
    End If
    'Save and Print
    wb2.SaveAs "C:\Documents and Settings\rsernowski\Documents\Newport Trades\" & FileName & ".xls", xlExcel8
    wb2.PrintOut
    'need to send the file
 
    If MsgBox("Click OK to EMail to Newport/Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
    Set OutMail = OutApp.CreateItem(0)
    With wb2
        With OutMail
               '.To = "cfsc.bpofa2@citi.com"
                .CC = "rsernowski@gmail.com
                .BCC = ""
                .Subject = "Trade-Newport Cdn Equity Fund -CITI"
                .Body = "Attached are Bluewater trade allocatons in excel"
                .Attachments.Add wb2.FullName
                .Send   'or use .Display
        End With
        On Error GoTo 0
    wb2.Close
    End With
 
    'Fill out NBCN Trade Advice print and send
    Set wb3 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\NBCN Trade Advice.xlt")
    With wb3.Worksheets("Sheet1")
        .Cells(4, 5) = T_Buy
        .Cells(4, 8) = T_Date
        .Cells(4, 9) = S_Date
        .Cells(4, 14) = T_Curr
        .Cells(4, 15) = T_Comm
        .Cells(4, 16) = S_Name
        .Cells(4, 17) = S_Number
        .Cells(4, 18) = T_Shares
        .Cells(4, 19) = T_Price
        .Cells(4, 22) = T_Total
        .Cells(4, 23) = T_DTC
    End With
    'Determine USD and CAD and fill out resepective areas'
    If T_Curr = "CAD" Then
        Cells(4, 1) = "297Z01A"
        Cells(4, 3) = "29701BC"
        Cells(4, 4) = "TU"
        Else
        Cells(4, 1) = "297Z01B"
        Cells(4, 3) = "29701BD"
        Cells(4, 4) = "NU"
   End If
  'send the document to NBCN
   If MsgBox("Click OK to EMail to Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub
   Set OutApp = CreateObject("Outlook.Application")
   OutApp.Session.Logon
   Set OutMail = OutApp.CreateItem(0)
   With wb3
        With OutMail
      '     .To = "ftpdepot@nbf.ca"
            .CC = "rsernowski@bluewaterinvestment.com"
            .BCC = ""
            .Subject = "Trade-Newport Cdn Equity Fund - NBCN"
            .Body = "Attached are Bluewater trade allocatons in excel"
            .Attachments.Add wb2.FullName
            .Send   'or use .Display
        End With
        On Error GoTo 0
        wb3.Close SaveChanges:=False
   End With
   End Sub
0
 
LVL 18

Expert Comment

by:Curt Lindstrom
ID: 24168007
Try this one.

Cheers,
Curt
Sub newport_trades1()

'

' newport_trades Macro

' Generate and send trade tickets for

'

    Dim FileName As String

    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook

    Dim ws As Worksheet

    Dim T_Buy, T_DTC, T_Date, S_Date, T_Shares, S_Name, S_Number, T_Comm, T_Price, T_Curr, T_Total, T_Clients, T_Alloc

    Dim OutApp As Object

    Dim OutMail As Object

    Dim cell As Range
 

    FileName = InputBox("Enter Original File Name")
 

    Set wb1 = Workbooks.Open("C:\Documents and Settings\rsernowski\Desktop\" & FileName & ".xls")

    Set wb2 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\CITI Trade Advice.xlt")

    'this is the new template'

    Set wb3 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\NBCN Trade Advice.xlt")
 

    'copy required cells from original file'

    With wb1.Worksheets("Sheet1")

        T_Buy = .Cells(7, 3)

        T_DTC = .Cells(7, 4)

        T_Date = .Cells(7, 7)

        S_Date = .Cells(7, 8)

        T_Shares = .Cells(7, 9)

        S_Name = .Cells(7, 10)

        S_Number = .Cells(7, 11)

        T_Comm = .Cells(7, 13)

        T_Price = .Cells(7, 14)

        T_Curr = .Cells(7, 15)

        T_Total = .Cells(7, 16)

    End With

    wb1.Close

    'Fill out the new template and Print'

    With wb2.Worksheets("Sheet1")

        .Cells(4, 5) = T_Buy

        .Cells(4, 8) = T_Date

        .Cells(4, 9) = S_Date

        .Cells(4, 14) = T_Curr

        .Cells(4, 15) = T_Comm

        .Cells(4, 16) = S_Name

        .Cells(4, 17) = S_Number

        .Cells(4, 18) = T_Shares

        .Cells(4, 19) = T_Price

        .Cells(4, 22) = T_Total

        .Cells(4, 23) = T_DTC

        'Determine USD and CAD and fill out resepective areas'

        Set wb2 = ActiveSheet

        If T_Curr = "CAD" Then

            .Cells(4, 1) = "297Z01A"

            .Cells(4, 3) = "29701BC"

            .Cells(4, 4) = "TU"

        Else

            .Cells(4, 1) = "297Z01B"

            .Cells(4, 3) = "29701BD"

            .Cells(4, 4) = "NU"

        End If

    End With

    'Fill out the older template and send

    With wb3.Worksheets("Sheet1")

        .Cells(3, 5) = T_Buy

        .Cells(3, 8) = T_Date

        .Cells(3, 9) = S_Date

        .Cells(3, 14) = T_Curr

        .Cells(3, 15) = T_Comm

        .Cells(4, 16) = S_Name

        .Cells(4, 17) = S_Number

        .Cells(4, 18) = T_Shares

        .Cells(4, 19) = T_Price

        .Cells(4, 22) = T_Total

        .Cells(4, 23) = T_DTC
 

        'Determine USD and CAD and fill out resepective areas'

        If T_Curr = "CAD" Then

            .Cells(4, 1) = "297Z01A"

            .Cells(4, 3) = "29701BC"

            .Cells(4, 4) = "TU"

        Else

            .Cells(4, 1) = "297Z01B"

            .Cells(4, 3) = "29701BD"

            .Cells(4, 4) = "NU"

        End If

    End With

    'print the newer template and save it

    wb2.Activate

    With ActiveSheet.PageSetup

        .Orientation = xlLandscape

        .PaperSize = xlPaperLetter

        .FitToPagesWide = 1

        .FitToPagesTall = 1

    End With

    ActiveWindow.SelectedSheets.PrintPreview

    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
 

    wb2.SaveAs ("C:\Documents and Settings\rsernowski\Documents\" & FileName & ".xls")
 
 

    If MsgBox("Click OK to EMail to Newport/Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub

    Set OutApp = CreateObject("Outlook.Application")

    OutApp.Session.Logon

    Set OutMail = OutApp.CreateItem(0)

    With wb2

        With OutMail

            .To = ""

            .CC = "rsernowski@gmail.com"

            .BCC = ""

            .Subject = ""

            .Body = ""

            .Attachments.Add wb2.FullName

            .Send   'or use .Display

        End With

        On Error GoTo 0

        wb2.Close SaveChanges:=False

    End With
 

    'send the document the older template

    wb3.Activate

    If MsgBox("Click OK to EMail to Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub

    Set OutApp = CreateObject("Outlook.Application")

    OutApp.Session.Logon

    Set OutMail = OutApp.CreateItem(0)

    With wb3

        With OutMail

            .To = "mymailplace.ca"

            .CC = "rsernowski@gmail.com"

            .BCC = ""

            .Subject = ""

            .Body = ""

            .Attachments.Add wb3.FullName

            .Send   'or use .Display

        End With

        On Error GoTo 0

        wb3.Close SaveChanges:=False

    End With

End Sub

Sub newport_trades()

'

' newport_trades Macro

' Generate and send trade tickets for Citi and NBCN

'

    Dim FileName As String

    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook

    Dim ws As Worksheet

    Dim T_Buy, T_DTC, T_Date, S_Date, T_Shares, S_Name, S_Number, T_Comm, T_Price, T_Curr, T_Total

    Dim OutApp As Object

    Dim OutMail As Object

    Dim cell As Range
 

    FileName = InputBox("Enter Original File Name")
 

    Set wb1 = Workbooks.Open("C:\Documents and Settings\rsernowski\Desktop\" & FileName & ".xls")

    Set wb2 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\CITI Trade Advice.xlt")
 

    'Copy the orginal file

    With wb1.Worksheets("Sheet1")

        T_Buy = .Cells(7, 3)

        T_DTC = .Cells(7, 4)

        T_Date = .Cells(7, 7)

        S_Date = .Cells(7, 8)

        T_Shares = .Cells(7, 9)

        S_Name = .Cells(7, 10)

        S_Number = .Cells(7, 11)

        T_Comm = .Cells(7, 13)

        T_Price = .Cells(7, 14)

        T_Curr = .Cells(7, 15)

        T_Total = .Cells(7, 16)

    End With

    wb1.Close

    'Fill out CITI Trade Advice and Print'

    With wb2.Worksheets("Sheet1")

        .Cells(4, 5) = T_Buy

        .Cells(4, 8) = T_Date

        .Cells(4, 9) = S_Date

        .Cells(4, 14) = T_Curr

        .Cells(4, 15) = T_Comm

        .Cells(4, 17) = S_Name

        .Cells(4, 18) = S_Number

        .Cells(4, 19) = T_Shares

        .Cells(4, 20) = T_Price

        .Cells(4, 23) = T_Total

        .Cells(4, 24) = T_DTC

        'Determine USD and CAD and fill out resepective areas'

        Set wb2 = ActiveSheet

        If T_Curr = "CAD" Then

            .Cells(4, 1) = "297Z01A"

            .Cells(4, 3) = "29701BC"

            .Cells(4, 4) = "TU"

        Else

            .Cells(4, 1) = "297Z01B"

            .Cells(4, 3) = "29701BD"

            .Cells(4, 4) = "NU"

        End If

    End With

    'Save and Print

    wb2.Activate

    With ActiveSheet.PageSetup

        .Orientation = xlLandscape

        .PaperSize = xlPaperLetter

        .FitToPagesWide = 1

        .FitToPagesTall = 1

    End With

    wb2.PrintOut

    wb2.SaveAs "C:\Documents and Settings\rsernowski\Documents\Newport Trades\" & FileName & ".xls", xlExcel8

    'need to send the file
 

    If MsgBox("Click OK to EMail to Newport/Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub

    Set OutApp = CreateObject("Outlook.Application")

    OutApp.Session.Logon

    Set OutMail = OutApp.CreateItem(0)

    With wb2

        With OutMail

            '.To = "cfsc.bpofa2@citi.com"

            .CC = "rsernowski@gmail.com"

            .BCC = ""

            .Subject = "Trade-Newport Cdn Equity Fund -CITI"

            .Body = "Attached are Bluewater trade allocatons in excel"

            .Attachments.Add wb2.FullName

            .Send   'or use .Display

        End With

        On Error GoTo 0

        wb2.Close

    End With
 

    'Fill out NBCN Trade Advice print and send

    Set wb3 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\NBCN Trade Advice.xlt")

    With wb3.Worksheets("Sheet1")

        .Cells(3, 5) = T_Buy

        .Cells(3, 8) = T_Date

        .Cells(3, 9) = S_Date

        .Cells(3, 14) = T_Curr

        .Cells(3, 15) = T_Comm

        .Cells(4, 16) = S_Name

        .Cells(4, 17) = S_Number

        .Cells(4, 18) = T_Shares

        .Cells(4, 19) = T_Price

        .Cells(4, 22) = T_Total

        .Cells(4, 23) = T_DTC
 

        'Determine USD and CAD and fill out resepective areas'

        If T_Curr = "CAD" Then

            .Cells(4, 1) = "297Z01A"

            .Cells(4, 3) = "29701BC"

            .Cells(4, 4) = "TU"

        Else

            .Cells(4, 1) = "297Z01B"

            .Cells(4, 3) = "29701BD"

            .Cells(4, 4) = "NU"

        End If

    End With

    'send the document to NBCN

    If MsgBox("Click OK to EMail to Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub

    Set OutApp = CreateObject("Outlook.Application")

    OutApp.Session.Logon

    Set OutMail = OutApp.CreateItem(0)

    With wb3

        With OutMail

            '     .To = "ftpdepot@nbf.ca"

            .CC = "rsernowski@bluewaterinvestment.com"

            .BCC = ""

            .Subject = "Trade-Newport Cdn Equity Fund - NBCN"

            .Body = "Attached are Bluewater trade allocatons in excel"

            .Attachments.Add wb2.FullName

            .Send   'or use .Display

        End With

        On Error GoTo 0

        wb3.Close SaveChanges:=False

    End With

End Sub

Open in new window

0
 

Author Comment

by:rsernowski
ID: 24272726
Hi Curt

Sorry for the dealy on this. I am gettign an error on this line/:
 Set wb2 = ActiveSheet
0
 
LVL 18

Expert Comment

by:Curt Lindstrom
ID: 24275110
Hi Robert,

That line was in the first code you submitted and I just left it in the code. Try to delete that line, it shouldn't be there.

Curt

0
 
LVL 18

Expert Comment

by:Curt Lindstrom
ID: 24275896
My last code snippet had 2 macros. It should only be one.

Try this one.

Curt


Sub newport_trades()

'

' newport_trades Macro

' Generate and send trade tickets for Citi and NBCN

'

    Dim FileName As String

    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook

    Dim ws As Worksheet

    Dim T_Buy, T_DTC, T_Date, S_Date, T_Shares, S_Name, S_Number, T_Comm, T_Price, T_Curr, T_Total

    Dim OutApp As Object

    Dim OutMail As Object

    Dim cell As Range

 

    FileName = InputBox("Enter Original File Name")

 

    Set wb1 = Workbooks.Open("C:\Documents and Settings\rsernowski\Desktop\" & FileName & ".xls")

    Set wb2 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\CITI Trade Advice.xlt")

 

    'Copy the orginal file

    With wb1.Worksheets("Sheet1")

        T_Buy = .Cells(7, 3)

        T_DTC = .Cells(7, 4)

        T_Date = .Cells(7, 7)

        S_Date = .Cells(7, 8)

        T_Shares = .Cells(7, 9)

        S_Name = .Cells(7, 10)

        S_Number = .Cells(7, 11)

        T_Comm = .Cells(7, 13)

        T_Price = .Cells(7, 14)

        T_Curr = .Cells(7, 15)

        T_Total = .Cells(7, 16)

    End With

    wb1.Close

    'Fill out CITI Trade Advice and Print'

    With wb2.Worksheets("Sheet1")

        .Cells(4, 5) = T_Buy

        .Cells(4, 8) = T_Date

        .Cells(4, 9) = S_Date

        .Cells(4, 14) = T_Curr

        .Cells(4, 15) = T_Comm

        .Cells(4, 17) = S_Name

        .Cells(4, 18) = S_Number

        .Cells(4, 19) = T_Shares

        .Cells(4, 20) = T_Price

        .Cells(4, 23) = T_Total

        .Cells(4, 24) = T_DTC

        'Determine USD and CAD and fill out resepective areas'

        If T_Curr = "CAD" Then

            .Cells(4, 1) = "297Z01A"

            .Cells(4, 3) = "29701BC"

            .Cells(4, 4) = "TU"

        Else

            .Cells(4, 1) = "297Z01B"

            .Cells(4, 3) = "29701BD"

            .Cells(4, 4) = "NU"

        End If

    End With

    'Save and Print

    wb2.Activate

    With ActiveSheet.PageSetup

        .Orientation = xlLandscape

        .PaperSize = xlPaperLetter

        .FitToPagesWide = 1

        .FitToPagesTall = 1

    End With

    wb2.PrintOut

    wb2.SaveAs "C:\Documents and Settings\rsernowski\Documents\Newport Trades\" & FileName & ".xls", xlExcel8

    'need to send the file

 

    If MsgBox("Click OK to EMail to Newport/Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub

    Set OutApp = CreateObject("Outlook.Application")

    OutApp.Session.Logon

    Set OutMail = OutApp.CreateItem(0)

    With wb2

        With OutMail

            '.To = "cfsc.bpofa2@citi.com"

            .CC = "rsernowski@gmail.com"

            .BCC = ""

            .Subject = "Trade-Newport Cdn Equity Fund -CITI"

            .Body = "Attached are Bluewater trade allocatons in excel"

            .Attachments.Add wb2.FullName

            .Send   'or use .Display

        End With

        On Error GoTo 0

        wb2.Close

    End With

 

    'Fill out NBCN Trade Advice print and send

    Set wb3 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\NBCN Trade Advice.xlt")

    With wb3.Worksheets("Sheet1")

        .Cells(3, 5) = T_Buy

        .Cells(3, 8) = T_Date

        .Cells(3, 9) = S_Date

        .Cells(3, 14) = T_Curr

        .Cells(3, 15) = T_Comm

        .Cells(4, 16) = S_Name

        .Cells(4, 17) = S_Number

        .Cells(4, 18) = T_Shares

        .Cells(4, 19) = T_Price

        .Cells(4, 22) = T_Total

        .Cells(4, 23) = T_DTC

 

        'Determine USD and CAD and fill out resepective areas'

        If T_Curr = "CAD" Then

            .Cells(4, 1) = "297Z01A"

            .Cells(4, 3) = "29701BC"

            .Cells(4, 4) = "TU"

        Else

            .Cells(4, 1) = "297Z01B"

            .Cells(4, 3) = "29701BD"

            .Cells(4, 4) = "NU"

        End If

    End With

    'send the document to NBCN

    If MsgBox("Click OK to EMail to Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub

    Set OutApp = CreateObject("Outlook.Application")

    OutApp.Session.Logon

    Set OutMail = OutApp.CreateItem(0)

    With wb3

        With OutMail

            '     .To = "ftpdepot@nbf.ca"

            .CC = "rsernowski@bluewaterinvestment.com"

            .BCC = ""

            .Subject = "Trade-Newport Cdn Equity Fund - NBCN"

            .Body = "Attached are Bluewater trade allocatons in excel"

            .Attachments.Add wb2.FullName

            .Send   'or use .Display

        End With

        On Error GoTo 0

        wb3.Close SaveChanges:=False

    End With

End Sub

Open in new window

0
 

Author Comment

by:rsernowski
ID: 24281057
Hey Curt

Almost got it! IO am getting an error on this line:
.Attachments.Add wb3.FullName (I changed it from wb2 to wb3).  The error is file not found.
Any thoughts?
Regards
robert
0
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 
LVL 18

Expert Comment

by:Curt Lindstrom
ID: 24286515
Try this.

Curt
Sub newport_trades()

'

' newport_trades Macro

' Generate and send trade tickets for Citi and NBCN

'

    Dim FileName As String

    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook

    Dim ws As Worksheet

    Dim T_Buy, T_DTC, T_Date, S_Date, T_Shares, S_Name, S_Number, T_Comm, T_Price, T_Curr, T_Total

    Dim OutApp As Object

    Dim OutMail As Object

    Dim cell As Range

 

    FileName = InputBox("Enter Original File Name")

 

    Set wb1 = Workbooks.Open("C:\Documents and Settings\rsernowski\Desktop\" & FileName & ".xls")

    Set wb2 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\CITI Trade Advice.xlt")

 

    'Copy the orginal file

    With wb1.Worksheets("Sheet1")

        T_Buy = .Cells(7, 3)

        T_DTC = .Cells(7, 4)

        T_Date = .Cells(7, 7)

        S_Date = .Cells(7, 8)

        T_Shares = .Cells(7, 9)

        S_Name = .Cells(7, 10)

        S_Number = .Cells(7, 11)

        T_Comm = .Cells(7, 13)

        T_Price = .Cells(7, 14)

        T_Curr = .Cells(7, 15)

        T_Total = .Cells(7, 16)

    End With

    wb1.Close

    'Fill out CITI Trade Advice and Print'

    With wb2.Worksheets("Sheet1")

        .Cells(4, 5) = T_Buy

        .Cells(4, 8) = T_Date

        .Cells(4, 9) = S_Date

        .Cells(4, 14) = T_Curr

        .Cells(4, 15) = T_Comm

        .Cells(4, 17) = S_Name

        .Cells(4, 18) = S_Number

        .Cells(4, 19) = T_Shares

        .Cells(4, 20) = T_Price

        .Cells(4, 23) = T_Total

        .Cells(4, 24) = T_DTC

        'Determine USD and CAD and fill out resepective areas'

        If T_Curr = "CAD" Then

            .Cells(4, 1) = "297Z01A"

            .Cells(4, 3) = "29701BC"

            .Cells(4, 4) = "TU"

        Else

            .Cells(4, 1) = "297Z01B"

            .Cells(4, 3) = "29701BD"

            .Cells(4, 4) = "NU"

        End If

    End With

    'Save and Print

    wb2.Activate

    With ActiveSheet.PageSetup

        .Orientation = xlLandscape

        .PaperSize = xlPaperLetter

        .FitToPagesWide = 1

        .FitToPagesTall = 1

    End With

    wb2.PrintOut

    wb2.SaveAs "C:\Documents and Settings\rsernowski\Documents\Newport Trades\" & FileName & ".xls", xlExcel8

    'need to send the file

 

    If MsgBox("Click OK to EMail to Newport/Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub

    Set OutApp = CreateObject("Outlook.Application")

    OutApp.Session.Logon

    Set OutMail = OutApp.CreateItem(0)

    With wb2

        With OutMail

            '.To = "cfsc.bpofa2@citi.com"

            .CC = "rsernowski@gmail.com"

            .BCC = ""

            .Subject = "Trade-Newport Cdn Equity Fund -CITI"

            .Body = "Attached are Bluewater trade allocatons in excel"

            .Attachments.Add wb2.FullName

            .Send   'or use .Display

        End With

        On Error GoTo 0

        wb2.Close

    End With

 

    'Fill out NBCN Trade Advice print and send

    Set wb3 = Workbooks.Open("C:\Documents and Settings\rsernowski\Application Data\Microsoft\Templates\NBCN Trade Advice.xlt")

    With wb3.Worksheets("Sheet1")

        .Cells(3, 5) = T_Buy

        .Cells(3, 8) = T_Date

        .Cells(3, 9) = S_Date

        .Cells(3, 14) = T_Curr

        .Cells(3, 15) = T_Comm

        .Cells(4, 16) = S_Name

        .Cells(4, 17) = S_Number

        .Cells(4, 18) = T_Shares

        .Cells(4, 19) = T_Price

        .Cells(4, 22) = T_Total

        .Cells(4, 23) = T_DTC

 

        'Determine USD and CAD and fill out resepective areas'

        If T_Curr = "CAD" Then

            .Cells(4, 1) = "297Z01A"

            .Cells(4, 3) = "29701BC"

            .Cells(4, 4) = "TU"

        Else

            .Cells(4, 1) = "297Z01B"

            .Cells(4, 3) = "29701BD"

            .Cells(4, 4) = "NU"

        End If

    End With

    'send the document to NBCN

    If MsgBox("Click OK to EMail to Citi, Cancel to STOP.", vbOKCancel) = vbCancel Then Exit Sub

    Set OutApp = CreateObject("Outlook.Application")

    OutApp.Session.Logon

    Set OutMail = OutApp.CreateItem(0)

        With OutMail

            '     .To = "ftpdepot@nbf.ca"

            .CC = "rsernowski@bluewaterinvestment.com"

            .BCC = ""

            .Subject = "Trade-Newport Cdn Equity Fund - NBCN"

            .Body = "Attached are Bluewater trade allocatons in excel"

            .Attachments.Add wb3.FullName

            .Send   'or use .Display

        End With

        On Error GoTo 0

        wb3.Close SaveChanges:=False

End Sub

Open in new window

0
 

Author Comment

by:rsernowski
ID: 24305286
Hi Curt ,
I am getting the same error on this line:
.Attachments.Add wb3.FullName
"cannot find this file. Verfiy the path and file name are correct.
Thanks for your help
Robert
0
 
LVL 18

Expert Comment

by:Curt Lindstrom
ID: 24310811
Hi Robert,
The first macro seems to be nearly ok. I think it's a matter of where you keep the macro. You need to have the macro in a separate file and not in one of the files you manipulate and close (wb1, wb2, wb3). You also need to save wb3 to get the file with the new values.

 .Attachments.Add wb3.FullName will send wb3 as it is before you add the new values. I suggest you use the same temporary save as is used in Ron DeBruin's sample,  which I assume you based your email sending on, before you send wb3.

Try to use the macro by pressing the button in the attached file. This is the macro as you had it at the beginning of your question.

You will need to add a save of wb3 if you want the updated file to be sent.

Regards,
Curt
Control.xls
0
 
LVL 18

Expert Comment

by:Curt Lindstrom
ID: 24310883
Hi Robert,

This version will save wb3 in the same way you save wb2 before sending it.

Regards,
Curt
Control-2.xls
0
 

Author Comment

by:rsernowski
ID: 24329359
Hi Curt,

I have keep all the macros on personal.xls . Perhaps it doesn't like that wb2 is saved with the same file name.?
Ideas?
Thanks
Robert
0
 

Author Comment

by:rsernowski
ID: 24329593
Hi Curt,

Sorry that is exactly as you have suggested.  I will work on saving with a different name: So I need something like NBCN+ the original file name?
0
 
LVL 18

Expert Comment

by:Curt Lindstrom
ID: 24348694
Hi Robert,

You can use any name you like to save the file. If you don't want to keep a copy of the updated file you can delete it with the "Kill" command before you exit the sub.

Curt
0
 

Author Comment

by:rsernowski
ID: 24358156
Hi Curt
I got it ! Thanks for your help. One last question.  I can't get it to print correctly or save in an older version of excel! I use excel 2007 and so is my template in 2007. I need to save the file as older version. Here is my code to print and save:

'Save and Print
    wb2.Activate
    With ActiveSheet.PageSetup
        .Orientation = xlLandscape
        .PaperSize = xlPaperLetter
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    wb2.PrintOut
    wb2.SaveAs ("\\BWDC\Common\Trade_tickets\Newport\CITI-" & FileName & ".xls")

When I try to open the saved file I get "The file you are tryimg to open is in a different format...."It opens but ...

The printing code, just prints in portrait and doesn't fit to 1 page!
Yep I am now saving to the server.
Any help would be appreciated
Thanks
Robert
   
0
 
LVL 18

Expert Comment

by:Curt Lindstrom
ID: 24364868
Hi Robert,

The macro in the attached Control-3.xls file is saving both wb2 and wb3 in Excel 2003 format. The printing in this macro does also work correctly. This is the same file as I uploaded previously with the difference that the button works properly in this version.

You need the xlExcel8 parameter at the end of your "SaveAs" line to save as Excel 2003 like this:
    wb2.SaveAs "C:\Documents and Settings\rsernowski\Documents\Newport Trades\" & FileName & ".xls", xlExcel8

Try by pressing the button in the attached file.

Regards,
Curt

Control-3.xls
0
 
LVL 18

Accepted Solution

by:
Curt Lindstrom earned 500 total points
ID: 24365237
Hi Robert,

I just noticed that 1 line was missing in the code which is need to change the page setup to 1 page wide and 1 page tall. The code should be:

    'Save and Print
    wb2.Activate
    With ActiveSheet.PageSetup
        .Orientation = xlLandscape
        .PaperSize = xlPaperLetter
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
    wb2.PrintOut

This is corrected in the attached sample file

Regards,
Curt
Control-4.xls
0
 

Author Closing Comment

by:rsernowski
ID: 31570077
Thanks for all your Help Curt! Really appreciate your time
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

I recently resolved a client's Office 2013 installation problem and wanted to offer an observation that may help you with troubleshooting similar issues. The client ordered three Dell Optiplex system units with the Windows 7 downgrade option inst…
This article will shed light on the latest trends when it comes to your resume building needs. For far too long, the traditional CV format has monopolized the recruitment market.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

757 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now