Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

Download attached files from Gmail by VBA (Excel 2016)

Posted on 2016-07-28
3
Medium Priority
?
246 Views
Last Modified: 2016-08-10
My company is currently using GMAIL, I do not have access to Outlook.  I currently have VBA code the generates Gmail emails.  I was hoping that I may be able to modify this in some way so that I can grab email attachments from a specific email.  I get several gmail emails with attachments that currently need to be manually downloaded then moved to the various files.  I may even consider add-in for Excel.

After researching the web without much success, I am turning to you guys to point me in the right direction.

Here is my current code:
Public Sub Email()

    On Error GoTo Email_Error

    Dim iMsg As Object
    Dim iConf As Object
    Dim strbody As String
    Dim strSubject As String
    Dim Flds As Variant
    Dim FilePath As String
    Dim FilePath1 As String
    Dim FilePath2 As String
    Dim nMth As String
    Dim curDate As String
    Dim nDate As String
    Dim nName As String
    Dim strContact As String
    Dim strTo As String
    Dim strFrom As String
    Dim aCell As Range
    Dim bolFound As Boolean
    Dim ws As Worksheet
    
    nDate = Format(Date, "mmddyyyy")
    nMth = Format(DateSerial(Year(Date), Month(Date), 1) - 1, "mmm yyyy")
    curDate = Format(Date, "mmm dd, yyyy")
    
    
    bolFound = False
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = "ContactList" Then bolFound = True
    Next ws
    If bolFound = False Then
        MsgBox "Couldn't find the required sheet." & Chr(10) & _
            "Aborting..."
    End If
    
    With ThisWorkbook.Worksheets("ContactList")
         For Each aCell In .Range("A:E")
            If aCell.Offset(1, 0).Value2 = .Range("M2").Value2 Then
                nName = aCell.Offset(1, 1).Value2
                nName = ReplaceAll(nName, " ", "_")
                
                If aCell.Offset(1, 2).Value2 = "From" Then
                    strFrom = aCell.Offset(1, 3).Value2
                End If
                
                Select Case aCell.Offset(1, 2).Value2
                    Case "Val"
                        strTo = "'" & aCell.Offset(0, 3).Value2 & "'"
                        strContact = aCell.Offset(0, 4).Value2
                       GoTo cont:
                    Case "Invoice"
                        strTo = strTo & "'" & aCell.Offset(0, 3).Value2 & _
                            ";" & "'"
                End Select
            End If
        Next aCell
cont:
    End With
    
    nName = Sheets("MainForm").Range("B3").Value2 & "_" & Sheets("MainForm").Range("D3").Value2
    FilePath = ""
    FilePath = Sheets("MainForm").Range("B3").Value & "\" & nMth & "\" & _
        nName & "_" & ReplaceAll(nMth, " ", "_") & "_" & "Invoice.pdf"

'    FilePath = Sheets("ContactList").Range("Q2").Value & "\" & nMth
    FilePath1 = FilePath & "\" & nName & "_" & ReplaceAll(nMth, " ", "_") & _
        "_" & "Invoice.pdf"
    FilePath2 = FilePath & "\" & nName & "_" & nDate & "_Invoice.xlsx"
    
   ' FilePath = Sheets("ContactList").Range("Q2").Value & "\" & nMth & "\" & nName & "_" & nDate & "_Invoice.xlsx"
        
        If FileFolderExists(FilePath) = False Then
                CreateNewDirectory (FilePath)
        End If
            If Dir(FilePath1, vbDirectory) = vbNullString Or Dir(FilePath2, _
                vbDirectory) = vbNullString Then
                If _
                    MsgBox("File not found, do you wish to create the files for " _
                    & nName & "_" & nDate & "_Invoice.xlsx and " & nName & "_" _
                    & ReplaceAll(nMth, " ", "_") & "_" & "Invoice.pdf ?", _
                    vbYesNo, "Create New File") = vbYes Then
                    'SaveFinalData
                    CreatePDF
                End If
            End If

    Set iMsg = CreateObject("CDO.Message")
    Set iConf = CreateObject("CDO.Configuration")
     
    iConf.Load -1 ' CDO Source Defaults
    Set Flds = iConf.Fields
        With Flds
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") _
                = True
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") _
                = 1
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") _
                = strFrom
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") _
                = "aspmx.l.google.com"
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") _
                = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") _
                = 25
            .Update
        End With
   
   'Sends Validation Email prior to emailing Invoice to Customer
    If ActiveSheet.OLEObjects("CheckBox1").Object.Value = True Then
        strSubject = "Quotewizard" & " " & nMth & ", Invoice for " & _
            ReplaceAll(nName, "_", " ") & " Review"
        strbody = strContact & "," & vbNewLine & vbNewLine & _
            "Please find attached the invoice for" & " " & nMth & "." & _
            vbNewLine & vbNewLine & _
            "Please validate changes and indicate any discrepancies." & _
            vbNewLine & vbNewLine & "Thank you," & vbNewLine & vbNewLine & _
            "Karen"
    Else
        strSubject = "Quotewizard" & " " & nMth & ", Invoice for " & nName _
            & ""
        strbody = "Please find attached the invoice for" & " " & nMth & "." & _
            vbNewLine & vbNewLine & _
            "Should you have any questions please contact your account representative." & _
            vbNewLine & vbNewLine & "Thank you," & vbNewLine & vbNewLine & _
            "KFS & vbNewLine & _
            "Financial Operations Analyst"

    End If
    
    On Error GoTo 0
        If Len(strTo) > 0 Then
            Set iMsg = CreateObject("CDO.Message")
                With iMsg
                     Set .Configuration = iConf
                    .TO = strFrom 'strTo
                    .From = strFrom
                    .Subject = strSubject
                    .TextBody = strbody
                    'Attaches the PDF file to Email
                     .AddAttachment FilePath1
                    'Attacheds the xlsx file to Email
                    .AddAttachment FilePath2
                    .Send
                   ' .Display
                End With
            Set iMsg = Nothing
        End If

    On Error GoTo 0
    Exit Sub

Email_Error:

    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Email of Sub modSaveFinalData"

End Sub

Open in new window

0
Comment
Question by:Karen Schaefer
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
3 Comments
 
LVL 15

Accepted Solution

by:
WalkaboutTigger earned 2000 total points
ID: 41733460
It may be felt I am taking a shortcut in my answer, but, like the scripting guys say, "It depends..."

There is, to the best of my knowledge, no trivial method of performing what you want to do.  The path may be exceedingly circuitous.

I believe the first step is to follow the instructions located here:

http://www.labnol.org/internet/send-gmail-to-google-drive/21236/

Which involves setting a search filter on Google Mail and having Google do the heavy lifting of saving the desired attachments to Google Drive.

If you then install the Google Drive app on your PC, it will be trivial to access these files directly.
0
 

Author Comment

by:Karen Schaefer
ID: 41736710
haven't had time to revisit this issue - please keep open.
0
 

Author Closing Comment

by:Karen Schaefer
ID: 41750948
thanks for your input, however, no longer on project
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This article describes how you can use Custom Document Properties to store settings and other information in your workbook so that they will be available the next time you open the workbook.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…

722 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