VBA un-time error `-2147467259 when using Set wdDoc

M

mecerrato

Board Regular
Joined
Oct 5, 2015
Messages
184
Office Version
  1. 365
Platform
  1. Windows
I have this code that copies and pastes a picture into an an email. It works 90% of the time, I cannot find the reason why sometimes I get a run-time error. I close out excel and wait a few minutes and then open the sheet up again and it then works.

Set wdDoc = Email.GetInspector.WordEditor

Run-time error `-2147467259 (80004005)':
The Operation Failed

VBA Code: 
Public Sub ScreenShotResults4_with_Current()
            Dim Rng As Range
            Dim olApp As Object
            Dim Email As Object
            Dim Sht As Excel.Worksheet
            Dim wdDoc As Word.Document
            ActiveSheet.Shapes("Row1Circle").Visible = False
            ActiveSheet.Shapes("Row2Circle").Visible = False
            ActiveSheet.Shapes("Row3Circle").Visible = False
            ActiveSheet.Shapes("Row4Circle").Visible = False
            ActiveSheet.Shapes("Row5Circle").Visible = False
            ActiveSheet.Shapes("Row6Circle").Visible = False
            ActiveSheet.Shapes("Row7Circle").Visible = False
            ActiveSheet.Shapes("Row8Circle").Visible = False
            ActiveSheet.Shapes("Row9Circle").Visible = False
            ActiveSheet.Shapes("Row10Circle").Visible = False
            ActiveSheet.Shapes("Row11Circle").Visible = False
            ActiveSheet.Shapes("Row12Circle").Visible = False
            ActiveSheet.Shapes("Apps1Circle").Visible = False
            ActiveSheet.Shapes("Apps2Circle").Visible = False
            ActiveSheet.Shapes("Apps3Circle").Visible = False
            ActiveSheet.Shapes("Apps4Circle").Visible = False
            ActiveSheet.Shapes("Apps5Circle").Visible = False
            ActiveSheet.Shapes("Apps6Circle").Visible = False
            ActiveSheet.Shapes("Apps7Circle").Visible = False
            ActiveSheet.Shapes("Apps8Circle").Visible = False
            ActiveSheet.Shapes("Apps9Circle").Visible = False
            ActiveSheet.Shapes("Apps10Circle").Visible = False
            ActiveSheet.Shapes("Apps11Circle").Visible = False
            ActiveSheet.Shapes("Apps12Circle").Visible = False
            ActiveSheet.Shapes("Fund1Circle").Visible = False
            ActiveSheet.Shapes("Fund2Circle").Visible = False
            ActiveSheet.Shapes("Fund3Circle").Visible = False
            ActiveSheet.Shapes("Fund4Circle").Visible = False
            ActiveSheet.Shapes("Fund5Circle").Visible = False
            ActiveSheet.Shapes("Fund6Circle").Visible = False
            ActiveSheet.Shapes("Fund7Circle").Visible = False
            ActiveSheet.Shapes("Fund8Circle").Visible = False
            ActiveSheet.Shapes("Fund9Circle").Visible = False
            ActiveSheet.Shapes("Fund10Circle").Visible = False
            ActiveSheet.Shapes("Fund11Circle").Visible = False
            ActiveSheet.Shapes("Fund12Circle").Visible = False
            ActiveSheet.Shapes("Fund12Circle").Visible = False

            Sheets("Summary").CheckBoxes("Branch_ChkBox").Visible = False
            Set Rng = Sheets("Summary").Range("B9:N37")
                Rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
            'Sheets("Summary").Branch_ChkBox.Visible = False
            
            'Row1Circle Sheets("Summary").CheckBoxes("Branch_ChkBox").Visible = False
            
            With Application
                .EnableEvents = False
                .ScreenUpdating = False
            End With
        
            Set olApp = CreateObject("Outlook.Application")
            Set Email = olApp.CreateItem(0)
            Set wdDoc = Email.GetInspector.WordEditor
        
            'strbody = "See production data for most recent 3 months.  "
        
            With Email
                .To = Worksheets("Summary").Range("B21").Value
                .Subject = "12 Month LO Production Lookback for " & Worksheets("Summary").Range("B21").Value & " (" & Worksheets("Summary").Range("B23").Value & "- " & Worksheets("Summary").Range("B34").Value & ")"
                '.HTMLBody = "<BODY style=font-size:12.5pt;font-family:Calibri>" & "</p>" & strbody & RangetoHTML(rng) & Signature
                .Display
            
                wdDoc.Range.PasteAndFormat Type:=wdChartPicture
            
                'if need setup inlineshapes hight & width
    With wdDoc.Content
        '--- paste the range image first, because it overwrites
        '    everything in the document
        
        .PasteAndFormat Type:=wdChartPicture
        .InlineShapes(1).Height = 350
        
        '--- now add our greeting at the start of the email
        .InsertBefore "See 12 month production data and current pipeline. " & vbCr & vbCr
                                   
        '--- finally add our sign off after the image
        .InsertAfter vbCr & _
                     "Thank you" & vbCr & vbCr
                     
    End With

        
                .Display
            End With
        
            With Application
                .EnableEvents = True
                .ScreenUpdating = True
            End With
        
            Set Email = Nothing
            Set olApp = Nothing
    Sheets("Summary").CheckBoxes("Branch_ChkBox").Visible = True
    ActiveSheet.Shapes("Row1Circle").Visible = True
    ActiveSheet.Shapes("Row2Circle").Visible = True
    ActiveSheet.Shapes("Row3Circle").Visible = True
    ActiveSheet.Shapes("Row4Circle").Visible = True
    ActiveSheet.Shapes("Row5Circle").Visible = True
    ActiveSheet.Shapes("Row6Circle").Visible = True
    ActiveSheet.Shapes("Row7Circle").Visible = True
    ActiveSheet.Shapes("Row8Circle").Visible = True
    ActiveSheet.Shapes("Row9Circle").Visible = True
    ActiveSheet.Shapes("Row10Circle").Visible = True
    ActiveSheet.Shapes("Row11Circle").Visible = True
    ActiveSheet.Shapes("Row12Circle").Visible = True
    ActiveSheet.Shapes("Apps1Circle").Visible = True
    ActiveSheet.Shapes("Apps2Circle").Visible = True
    ActiveSheet.Shapes("Apps3Circle").Visible = True
    ActiveSheet.Shapes("Apps4Circle").Visible = True
    ActiveSheet.Shapes("Apps5Circle").Visible = True
    ActiveSheet.Shapes("Apps6Circle").Visible = True
    ActiveSheet.Shapes("Apps7Circle").Visible = True
    ActiveSheet.Shapes("Apps8Circle").Visible = True
    ActiveSheet.Shapes("Apps9Circle").Visible = True
    ActiveSheet.Shapes("Apps10Circle").Visible = True
    ActiveSheet.Shapes("Apps11Circle").Visible = True
    ActiveSheet.Shapes("Apps12Circle").Visible = True
    ActiveSheet.Shapes("Fund1Circle").Visible = True
    ActiveSheet.Shapes("Fund2Circle").Visible = True
    ActiveSheet.Shapes("Fund3Circle").Visible = True
    ActiveSheet.Shapes("Fund4Circle").Visible = True
    ActiveSheet.Shapes("Fund5Circle").Visible = True
    ActiveSheet.Shapes("Fund6Circle").Visible = True
    ActiveSheet.Shapes("Fund7Circle").Visible = True
    ActiveSheet.Shapes("Fund8Circle").Visible = True
    ActiveSheet.Shapes("Fund9Circle").Visible = True
    ActiveSheet.Shapes("Fund10Circle").Visible = True
    ActiveSheet.Shapes("Fund11Circle").Visible = True
    ActiveSheet.Shapes("Fund12Circle").Visible = True
    ActiveSheet.Shapes("Fund12Circle").Visible = True
    End Sub
 

Excel Facts

Excel Joke
Why can't spreadsheets drive cars? They crash too often!
Sort by date Sort by votes
Try moving that line to within your With/End With statement, and after .Display...

VBA Code: 
            With Email
                .To = Worksheets("Summary").Range("B21").Value
                .Subject = "12 Month LO Production Lookback for " & Worksheets("Summary").Range("B21").Value & " (" & Worksheets("Summary").Range("B23").Value & "- " & Worksheets("Summary").Range("B34").Value & ")"
                '.HTMLBody = "<BODY style=font-size:12.5pt;font-family:Calibri>" & "</p>" & strbody & RangetoHTML(rng) & Signature
                .Display
                Set wdDoc = .GetInspector.WordEditor
                wdDoc.Range.PasteAndFormat Type:=wdChartPicture
                'etc
                '
                '
            End With

Hope this helps!
 
Last edited:
Upvote 1
Solution
By the way, your code to set the visible property of your shapes can be re-written as follows...

VBA Code: 
            Dim i As Long
            For i = 1 To 12
                ActiveSheet.Shapes("Row" & i & "Circle").Visible = False
                ActiveSheet.Shapes("Apps" & i & "Circle").Visible = False
                ActiveSheet.Shapes("Fund" & i & "Circle").Visible = False
            Next i

Hope this helps!
 
Upvote 1
Domenic said:
Try moving that line to within your With/End With statement, and after .Display...

VBA Code: 
            With Email
                .To = Worksheets("Summary").Range("B21").Value
                .Subject = "12 Month LO Production Lookback for " & Worksheets("Summary").Range("B21").Value & " (" & Worksheets("Summary").Range("B23").Value & "- " & Worksheets("Summary").Range("B34").Value & ")"
                '.HTMLBody = "<BODY style=font-size:12.5pt;font-family:Calibri>" & "</p>" & strbody & RangetoHTML(rng) & Signature
                .Display
                Set wdDoc = .GetInspector.WordEditor
                wdDoc.Range.PasteAndFormat Type:=wdChartPicture
                'etc
                '
                '
            End With

Hope this helps!
Click to expand...
thank you, this fixed it
 
Upvote 0
Hi Domenic,

I have similar problem when running the macro. I am receiving this error message:

Run-time error ‘-2147467259 (80004005)’:
The operation failed

This is my vba code:

Sub MassEmailer()
'wb pwd is Summer2019
'pwd is apple
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Dim Datahouse1() As Variant
Dim ListSize As Variant
Dim Counter1 As Variant
Dim Counter2 As Variant

'With UserForm1

'.PopUp = True
'.Display

'End With

ListSize = Application.Workbooks("MassEmailer.xlsm").Sheets("List").Range("B:B").Cells.SpecialCells(xlCellTypeConstants).Count
ReDim Datahouse1(1 To ListSize, 1 To 7)

For Counter1 = 1 To ListSize
For Counter2 = 1 To 7
Datahouse1(Counter1, Counter2) = Application.Workbooks("MassEmailer.xlsm").Sheets("List").Cells(Counter1, Counter2)
Next Counter2
Next Counter1

Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngSubject As Range
Dim rngBody As Range
Dim rngAttach As Range
Dim editor As Object
Set objOutlook = CreateObject("Outlook.Application")


Dim Counter3 As Variant

Dim Attachment1 As Variant
Dim Attachment2 As Variant
Dim Attachment3 As Variant
Dim Attachment4 As Variant
Dim Attachment5 As Variant
Dim Attachment6 As Variant

Attachment1 = Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(2, 2)
Attachment2 = Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(3, 2)
Attachment3 = Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(4, 2)
Attachment4 = Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(5, 2)
Attachment5 = Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(6, 2)
Attachment6 = Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(7, 2)

Dim TemplateFileLocation As Variant
TemplateFileLocation = Application.Workbooks("MassEmailer.xlsm").Sheets("Template").Cells(2, 3)
Set App = New Word.Application
Dim doc As Word.Document
Set App = CreateObject("Word.Application")
App.Visible = True

For Counter3 = 2 To ListSize
If Len(Datahouse1(Counter3, 1)) <> 0 Then
Set objMail = objOutlook.CreateItem(0)
Set doc = App.Documents.Open(Filename:=TemplateFileLocation)
With doc.Content.Find
.Text = "$NAME$"
.Replacement.Text = Datahouse1(Counter3, 3)
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
'With objMail
'.editor.Content.Paste
'End With
End With
doc.Content.Copy

End If
'Set objMail = objOutlook.CreateItem(0)
With objMail
'On Error Resume Next
If Len(Datahouse1(Counter3, 1)) <> 0 Then
.To = Datahouse1(Counter3, 4)
.CC = Application.Workbooks("MassEmailer.xlsm").Sheets("ExtraCC").Cells(2, 2)
.Subject = Datahouse1(Counter3, 6)
.ReadReceiptRequested = True
.SentOnBehalfOfName = confidential email address
.BodyFormat = olFormatRichText
Set editor = .GetInspector.WordEditor
editor.Content.Paste
.Display
'.Body = .editor.Content.Paste
doc.Close SaveChanges:=wdDoNotSaveChanges

'.CC = Application.Workbooks("MassEmailer.xlsm").Sheets("Templates").Cells(4, 2)
'.OriginatorDeliveryReportRequested = True



End If

If Len(Attachment1) > 0 Then
.Attachments.Add Attachment1
End If
If Len(Attachment2) > 0 Then
.Attachments.Add Attachment2
End If
If Len(Attachment3) > 0 Then
.Attachments.Add Attachment3
End If
If Len(Attachment4) > 0 Then
.Attachments.Add Attachment4
End If
If Len(Attachment5) > 0 Then
.Attachments.Add Attachment5
End If
If Len(Attachment6) > 0 Then
.Attachments.Add Attachment6
End If
'& "TCR " & Month(Date) & " " & Year(Date) & ".xlsx"
If Len(Datahouse1(Counter3, 5)) <> 0 Then
.Send
End If
End With

'.Attachments.Add Environ("USERPROFILE") & "\Desktop\" & "TCR " & Month(Date) & " " & Year(Date) & ".xlsx"
'.Display
'With objMail


'End With
'Set objMail = Nothing


Next Counter3

'With objMail
'.cc = wb1.Worksheets("Macro Controls").Cells(2, 8) & ";" & wb1.Worksheets("Macro Controls").Cells(2, 9) & ";" & wb1.Worksheets("Macro Controls").Cells(2, 10) & ";" & wb1.Worksheets("Macro Controls").Cells(2, 11)
'End With

Set objOutlook = Nothing
Set objMail = Nothing
Set rngTo = Nothing
Set rngSubject = Nothing
Set rngBody = Nothing
Set rngAttach = Nothing


Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True

MsgBox "Job Done!"

End Sub
Sub GetFilePath1()
Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose Attachment 1"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
FileSelected = .SelectedItems(1)
End With
Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(2, 2) = FileSelected
End Sub
Sub GetFilePath2()
Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose Attachment 2"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
FileSelected = .SelectedItems(1)
End With
Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(3, 2) = FileSelected
End Sub
Sub GetFilePath3()
Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose Attachment 3"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
FileSelected = .SelectedItems(1)
End With
Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(4, 2) = FileSelected
End Sub
Sub GetFilePath4()
Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose Attachment 4"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
FileSelected = .SelectedItems(1)
End With
Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(5, 2) = FileSelected
End Sub
Sub GetFilePath5()
Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose Attachment 5"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
FileSelected = .SelectedItems(1)
End With
Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(6, 2) = FileSelected
End Sub
Sub GetFilePath6()
Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose Attachment 6"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
FileSelected = .SelectedItems(1)
End With
Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(7, 2) = FileSelected
End Sub
Sub GetFilePath7()
Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose Template"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
FileSelected = .SelectedItems(1)
End With
Application.Workbooks("MassEmailer.xlsm").Sheets("Template").Cells(2, 3) = FileSelected
End Sub

Can you please help me with this? I really appreciate your help in advance
 
Upvote 0
Domenic said:
Try moving that line to within your With/End With statement, and after .Display...

VBA Code: 
            With Email
                .To = Worksheets("Summary").Range("B21").Value
                .Subject = "12 Month LO Production Lookback for " & Worksheets("Summary").Range("B21").Value & " (" & Worksheets("Summary").Range("B23").Value & "- " & Worksheets("Summary").Range("B34").Value & ")"
                '.HTMLBody = "<BODY style=font-size:12.5pt;font-family:Calibri>" & "</p>" & strbody & RangetoHTML(rng) & Signature
                .Display
                Set wdDoc = .GetInspector.WordEditor
                wdDoc.Range.PasteAndFormat Type:=wdChartPicture
                'etc
                '
                '
            End With

Hope this helps!
Click to expand...

Hi Domenic,

I have similar problem when running the macro. I am receiving this error message:

Run-time error ‘-2147467259 (80004005)’:
The operation failed

This is my vba code:

Sub MassEmailer()
'wb pwd is Summer2019
'pwd is apple
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False

Dim Datahouse1() As Variant
Dim ListSize As Variant
Dim Counter1 As Variant
Dim Counter2 As Variant

'With UserForm1

'.PopUp = True
'.Display

'End With

ListSize = Application.Workbooks("MassEmailer.xlsm").Sheets("List").Range("B:B").Cells.SpecialCells(xlCellTypeConstants).Count
ReDim Datahouse1(1 To ListSize, 1 To 7)

For Counter1 = 1 To ListSize
For Counter2 = 1 To 7
Datahouse1(Counter1, Counter2) = Application.Workbooks("MassEmailer.xlsm").Sheets("List").Cells(Counter1, Counter2)
Next Counter2
Next Counter1

Dim objOutlook As Object
Dim objMail As Object
Dim rngTo As Range
Dim rngSubject As Range
Dim rngBody As Range
Dim rngAttach As Range
Dim editor As Object
Set objOutlook = CreateObject("Outlook.Application")


Dim Counter3 As Variant

Dim Attachment1 As Variant
Dim Attachment2 As Variant
Dim Attachment3 As Variant
Dim Attachment4 As Variant
Dim Attachment5 As Variant
Dim Attachment6 As Variant

Attachment1 = Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(2, 2)
Attachment2 = Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(3, 2)
Attachment3 = Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(4, 2)
Attachment4 = Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(5, 2)
Attachment5 = Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(6, 2)
Attachment6 = Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(7, 2)

Dim TemplateFileLocation As Variant
TemplateFileLocation = Application.Workbooks("MassEmailer.xlsm").Sheets("Template").Cells(2, 3)
Set App = New Word.Application
Dim doc As Word.Document
Set App = CreateObject("Word.Application")
App.Visible = True

For Counter3 = 2 To ListSize
If Len(Datahouse1(Counter3, 1)) <> 0 Then
Set objMail = objOutlook.CreateItem(0)
Set doc = App.Documents.Open(Filename:=TemplateFileLocation)
With doc.Content.Find
.Text = "$NAME$"
.Replacement.Text = Datahouse1(Counter3, 3)
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
'With objMail
'.editor.Content.Paste
'End With
End With
doc.Content.Copy

End If
'Set objMail = objOutlook.CreateItem(0)
With objMail
'On Error Resume Next
If Len(Datahouse1(Counter3, 1)) <> 0 Then
.To = Datahouse1(Counter3, 4)
.CC = Application.Workbooks("MassEmailer.xlsm").Sheets("ExtraCC").Cells(2, 2)
.Subject = Datahouse1(Counter3, 6)
.ReadReceiptRequested = True
.SentOnBehalfOfName = confidential email address
.BodyFormat = olFormatRichText
Set editor = .GetInspector.WordEditor
editor.Content.Paste
.Display
'.Body = .editor.Content.Paste
doc.Close SaveChanges:=wdDoNotSaveChanges

'.CC = Application.Workbooks("MassEmailer.xlsm").Sheets("Templates").Cells(4, 2)
'.OriginatorDeliveryReportRequested = True



End If

If Len(Attachment1) > 0 Then
.Attachments.Add Attachment1
End If
If Len(Attachment2) > 0 Then
.Attachments.Add Attachment2
End If
If Len(Attachment3) > 0 Then
.Attachments.Add Attachment3
End If
If Len(Attachment4) > 0 Then
.Attachments.Add Attachment4
End If
If Len(Attachment5) > 0 Then
.Attachments.Add Attachment5
End If
If Len(Attachment6) > 0 Then
.Attachments.Add Attachment6
End If
'& "TCR " & Month(Date) & " " & Year(Date) & ".xlsx"
If Len(Datahouse1(Counter3, 5)) <> 0 Then
.Send
End If
End With

'.Attachments.Add Environ("USERPROFILE") & "\Desktop\" & "TCR " & Month(Date) & " " & Year(Date) & ".xlsx"
'.Display
'With objMail


'End With
'Set objMail = Nothing


Next Counter3

'With objMail
'.cc = wb1.Worksheets("Macro Controls").Cells(2, 8) & ";" & wb1.Worksheets("Macro Controls").Cells(2, 9) & ";" & wb1.Worksheets("Macro Controls").Cells(2, 10) & ";" & wb1.Worksheets("Macro Controls").Cells(2, 11)
'End With

Set objOutlook = Nothing
Set objMail = Nothing
Set rngTo = Nothing
Set rngSubject = Nothing
Set rngBody = Nothing
Set rngAttach = Nothing


Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
ActiveSheet.DisplayPageBreaks = True

MsgBox "Job Done!"

End Sub
Sub GetFilePath1()
Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose Attachment 1"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
FileSelected = .SelectedItems(1)
End With
Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(2, 2) = FileSelected
End Sub
Sub GetFilePath2()
Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose Attachment 2"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
FileSelected = .SelectedItems(1)
End With
Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(3, 2) = FileSelected
End Sub
Sub GetFilePath3()
Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose Attachment 3"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
FileSelected = .SelectedItems(1)
End With
Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(4, 2) = FileSelected
End Sub
Sub GetFilePath4()
Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose Attachment 4"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
FileSelected = .SelectedItems(1)
End With
Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(5, 2) = FileSelected
End Sub
Sub GetFilePath5()
Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose Attachment 5"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
FileSelected = .SelectedItems(1)
End With
Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(6, 2) = FileSelected
End Sub
Sub GetFilePath6()
Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose Attachment 6"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
FileSelected = .SelectedItems(1)
End With
Application.Workbooks("MassEmailer.xlsm").Sheets("Attachments").Cells(7, 2) = FileSelected
End Sub
Sub GetFilePath7()
Set myFile = Application.FileDialog(msoFileDialogOpen)
With myFile
.Title = "Choose Template"
.AllowMultiSelect = False
If .Show <> -1 Then
Exit Sub
End If
FileSelected = .SelectedItems(1)
End With
Application.Workbooks("MassEmailer.xlsm").Sheets("Template").Cells(2, 3) = FileSelected
End Sub

Can you please help me with this? I really appreciate your help in advance
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Add text before pasting pic in outlook
Replies
2
Views
91
DanteAmor
DanteAmor
M
  • Question Question
code to include a column or more based on checkbox
Replies
6
Views
147
mecerrato
M
J
  • Question Question
Copy Picture - VBA
2
Replies
10
Views
271
Logit
Logit
M
  • Question Question
Creating and emailing Excel sheet with only visible data
Replies
0
Views
507
mecerrato
M
E
  • Question Question
Help Cleaning Up / Optimizing VBA Code
Replies
6
Views
545
offthelip
O

Forum statistics

Threads
1,224,823
Messages
6,181,170
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top