1 Replies - 495 Views - Last Post: 16 December 2013 - 12:02 PM Rate Topic: -----

#1 AnnaSwanna  Icon User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 1
  • Joined: 16-December 13

VBA Excel/Outlook/Powerpoint Integration assignment.

Posted 16 December 2013 - 11:56 AM

Good Afternoon everyone, I am stuck on an assignment and I was wondering if anyone could point out what exactly is going wrong.

here is the assignment:

3. Start Excel, open Assign_15_Excel_Loans, and activate VBA (Alt-F11).
4. Add code to the Letters macro to do the following:
a. In Outlook, create a Drafts folder with a name equal to the name of the “Loans” worksheet.
i. Before actually creating the folder, check if a Drafts folder by the same name already exists and, if it does, issue a message and exit the procedure.
b. For each loan on the Loans sheet, create an email with the following specifications:
i. Subject set to the word “Loan” followed by the Loan #.
ii. To set to the Last Name followed by “@RingDing.com”.
iii. Body set to “Please see attached.”.
iv. Attachments set to the letter that was created and saved for the loan.
v. Move the email to the Drafts folder that was just created.
c. When done with all loans on the Loans sheet, open the Assign_15_Power_Loan_Stats presentation and add a slide to the end with the following specifications:
i. Slide layout of “Title Only”.
ii. Set the text of the title to be equal to the name of the “Loans” worksheet.
iii. In Excel, create a Bar Chart showing the Number of Loans that were Approved and Rejected then cut and paste this Bar Chart as a Shape onto the new slide.
1. Reduce the size (Width & Height) of the Bar Chart Shape by 70%.
2. Set the location (Left & Top) of the Bar Chart Shape to be 70 and 200, respectively.
iv. In Excel, create a Column Chart showing the Amount of Loans that were Approved and Rejected then cut and paste this Column Chart as a Shape onto the new slide.
1. Reduce the size (Width & Height) of the Column Chart Shape by 70%.
2. Set the location (Left & Top) of the Column Chart Shape to be 370 and 200, respectively.
d. Save and close the presentation.
e. Close PowerPoint and free up the
PowerPoint Application object.

Here is my code so far. Please note that I have not finished the the bar chart things as I would like to get my current issues sorted out before I attempt to go any farther. I get an error saying that the folder cannot be created in outlook.

Here is my code:


Option Explicit


Public Sub Letters()

' Save the current path
Dim CP As String
CP = ActiveWorkbook.Path

' Fire up the WORD application
Dim WA As Word.Application
Set WA = CreateObject("Word.Application")

' Open the APPROVAL letter
Dim AppDoc As Document
WA.Documents.Open CP & "\" & "Assign_15_Word_Loan_Approve.docx", , True
Set AppDoc = WA.ActiveDocument

' Open the REJECTION letter
Dim RejDoc As Document
WA.Documents.Open CP & "\" & "Assign_15_Word_Loan_Reject.docx", , True
Set RejDoc = WA.ActiveDocument

' Bring OUTLOOK into the project
Dim OA As Outlook.Application
Set OA = CreateObject("Outlook.Application")
Dim myNS As NameSpace
Set myNS = OA.GetNamespace("MAPI")

' Add a drafts folder
OA.GetNamespace("MAPI").GetDefaultFolder(olFolderDrafts) _
.Folders.Add Name:=Worksheets(1).Name, Type:=olFolderDrafts
Dim XF As Folder
Set XF = myNS.GetDefaultFolder(olFolderDrafts).Folders.Item(Worksheets(1).Name)

If XF.Name = XF.Name Then
MsgBox "The Folder already exists"
Exit Sub
End If


' Loop thru the STATUS range checking if the status was APPROVE or REJECT
Dim r As Range
For Each r In Range("Status")
' For Each r In Range("Test")
If UCase(r.Value) = "APPROVE" Then ' Format & save the APPROVE letter
AppDoc.FormFields("AMT").Result = r.Offset(0, -4).Text
AppDoc.FormFields("PMT").Result = r.Offset(0, -1).Text
AppDoc.FormFields("NAME").Result = _
r.Offset(0, -9).Value & " " & r.Offset(0, -10).Text
AppDoc.FormFields("ADDR").Result = r.Offset(0, -8).Text
AppDoc.FormFields("CITY").Result = _
r.Offset(0, -7).Text & ", " & _
r.Offset(0, -6).Text & " " & _
r.Offset(0, -5).Text
AppDoc.FormFields("AMT1").Result = r.Offset(0, -4).Text
AppDoc.FormFields("PMT1").Result = r.Offset(0, -1).Text
AppDoc.FormFields("RATE1").Result = r.Offset(0, -3).Text
AppDoc.FormFields("TERM1").Result = r.Offset(0, -2).Text
AppDoc.SaveAs2 CP & "\" & "zAPPROVE-" & r.Offset(0, -11).Value & ".docx"
Range("ApproveCount").Value = Range("ApproveCount").Value + 1
Range("ApproveAmount").Value = Range("ApproveAmount").Value + _
r.Offset(0, -4).Value
Else ' Format & save the REJECT letter
RejDoc.FormFields("AMT").Result = r.Offset(0, -4).Text
RejDoc.FormFields("COMMENT").Result = r.Offset(0, 1).Text
RejDoc.FormFields("NAME").Result = _
r.Offset(0, -9).Value & " " & r.Offset(0, -10).Text
RejDoc.FormFields("ADDR").Result = r.Offset(0, -8).Text
RejDoc.FormFields("CITY").Result = _
r.Offset(0, -7).Text & ", " & _
r.Offset(0, -6).Text & " " & _
r.Offset(0, -5).Text
RejDoc.SaveAs2 CP & "\" & "zREJECT-" & r.Offset(0, -11).Value & ".docx"
Range("RejectCount").Value = Range("RejectCount").Value + 1
Range("RejectAmount").Value = Range("RejectAmount").Value + _
r.Offset(0, -4).Value
End If
Next r


' Creates message.
For Each r In Range("status")
If Range("Status").Text = "APPROVE" Then
Dim myMessage As MailItem
Set myMessage = OA.CreateItem(olMailItem)
With myMessage
.To = r.Offset(0, -10).Value & "@RingDing.com"
.Subject = "Loan" & r.Offset(0, -11).Value
.Body = "Please See Attached"
.Attachments.Add (CP & "\" & "zAPPROVE-" & r.Offset(0, -11).Value & ".docx")
.Move (XF)
End With
ElseIf Range("Status").Text = "REJECT" Then
With myMessage
.To = r.Offset(0, -10).Value & "@RingDing.com"
.Subject = "Loan" & r.Offset(0, -11).Value
.Body = "Please See Attached"
.Attachments.Add (CP & "\" & "zReject-" & r.Offset(0, -11).Value & ".docx")
.Move (XF)
End With
End If
Next r

Set myMessage = Nothing

' Bring POWERPOINT into the project
Dim PP As PowerPoint.Application
Set PP = CreateObject("PowerPoint.Application")


' Open Assign_15_Power_Loans_Stats
Dim slnum As Integer
Dim PS As Presentation

PP.Presentations.Open CP & "/" & "Assign_15_Power_Loan_Stats.pptx", , , msoFalse
Set PS = PP.ActivePresentation



' Add slide with name of sheet
slnum = ActivePresentation.Slides.Count + 1
ActivePresentation.Slides.Add Index:=slnum, Layout:=ppLayoutTitle
ActivePresentation.Slides(slnum).Shapes(1).TextFrame.TextRange.Text = Worksheets(1).Name



' Close both documents and make sure to discard any & all changes
AppDoc.Close wdDoNotSaveChanges
RejDoc.Close wdDoNotSaveChanges

' Stop WORD and free-up memory
WA.Quit
Set WA = Nothing

' Shutdown OUTLOOK
OA.Quit
Set OA = Nothing



End Sub

Sorry if it isn't so nice and neat, I have been moving things around and trying things left and right so its a mess now.

Thank you very much for your help.

Is This A Good Question/Topic? 0
  • +

Replies To: VBA Excel/Outlook/Powerpoint Integration assignment.

#2 andrewsw  Icon User is offline

  • Fire giant boob nipple gun!
  • member icon

Reputation: 3524
  • View blog
  • Posts: 12,031
  • Joined: 12-December 12

Re: VBA Excel/Outlook/Powerpoint Integration assignment.

Posted 16 December 2013 - 12:02 PM

Quote

I get an error saying that the folder cannot be created in outlook.

Post the full error message, and tell us what line it takes you to when you press Break (or Debug).

BTW I don't know why you are posting your entire assignment and entire code, which should be wrapped in code tags :whistling:

This post has been edited by andrewsw: 16 December 2013 - 12:04 PM

Was This Post Helpful? 0
  • +
  • -

Page 1 of 1