VBAscript run macro Accepting Update Links

[jon2249]

Hi All--
I have an excel document that's pulling data from an External Source that is FTP into the server every morning at 7am. When running the VB script, The popup "This workbook contains links to one or more external sources..." is holding up the macro from emailing the excel table to the distribution list. Eventually this VBscript will be on a task scheduler to be run at 8am every morning.

The VBA script is below, I thought the AskToUpdateLinks would solve the problem but it does not update the data leaving the popup there. The script continues when I press update on the screen.
Lastly, I'm trying to move the Excel external source "Daily Pickup Report.xlsx" to Archive folder and rename adding Current Date '0512' in front of the Excel doc name as the file with same name will be dumped again the next morning.

I appreciate any help possible!
Thanks!!

VBA Script

set objExcel = CreateObject("Excel.Application")
objExcel.Application.Run "'Z:\Revenue\Reports\Master Daily Pickup Report.xlsm'!Module1.TableToOutlook_Single"
objExcel.AskToUpdateLinks = True
objExcel.DisplayAlerts = False
ObjExcel.Application.Quit
Set objExcel = Nothing
MsgBox "Complete"

MACRO

Sub TableToOutlook_Single()

'Declare Outlook Variables
Dim oLookApp As Outlook.Application
Dim oLookItm As Outlook.MailItem
Dim oLookIns As Outlook.Inspector

'Declare Word Variables
Dim oWrdDoc As Word.Document
Dim oWrdRng As Word.Range
Dim oWrdTbl As Word.Table

'Delcare Excel Variables
Dim ExcTbl As ListObject

On Error Resume Next

'Get the Active instance of Outlook if there is one
Set oLookApp = GetObject(, "Outlook.Application")

'If Outlook isn't open then create a new instance of Outlook
If Err.Number = 429 Then

'Clear Error
Err.Clear

'Create a new instance of Outlook
Set oLookApp = New Outlook.Application

End If

'Create a new email
Set oLookItm = oLookApp.CreateItem(olMailItem)

'Create a reference to the Excel Table
Set ExcTbl = Sheet1.ListObjects(1)

With oLookItm

'Define some basic info of our email
.To = "xyz@abc.com"
'.CC = "xyz@abc.com"
.Subject = "Daily Pickup"
.Body = Range("A2").Value


'Display the email
.Display

'Get the Active Inspector
Set oLookIns = .GetInspector

'Get the document within the inspector
Set oWrdDoc = oLookIns.WordEditor

'Copy the table
ExcTbl.Range.Copy

'Define the range, insert a blank line, collapse the selection.
Set oWrdRng = oWrdDoc.Application.ActiveDocument.Content
oWrdRng.Collapse Direction:=wdCollapseEnd

'Add a new paragragp and then a break
Set oWrdRng = oWdEditor.Paragraphs.Add
'oWrdRng.InsertBreak

'Paste the object.
oWrdRng.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False

'Create a reference to the Word Table
Set oWrdTbl = oWrdDoc.Tables(oWrdDoc.Tables.Count)

'Make sure it fits to the email length
oWrdTbl.AllowAutoFit = True
oWrdTbl.AutoFitBehavior (wdAutoFitWindow)
.Send
End With


End Sub

 

[jon2249]

Problem solved.. Woops, Asktoupdatelinks = false instead of true.

set objExcel = CreateObject("Excel.Application")
objExcel.AskToUpdateLinks = False
objExcel.Application.Run "'Z:\Revenue Mgmt\Reports\Master Daily Pickup Report.xlsm'!Module1.TableToOutlook_Single"
objExcel.DisplayAlerts = False
ObjExcel.Application.Quit
objExcel.Quit
Set objExcel = Nothing
MsgBox "Complete"