Refresh SQL data link by macro instead of excels connection wizard

Hi,

I have finally got round to linking all my spreadsheets up to our oracle database through an access SQL query, one problem I have with one workbook is that the on open macro completes before the workbook updates its SQL link.

The SQL is set up through excels normal external data link wizard and runs when you open the workbook. I need a way to trigger the SQL refresh from the macro below and make sure the macro doesn't continue until the SQL refresh is complete.

Code for this workbook is below, the SQL link is on the workbook called "UPDATER", the workbook called "MASTER SAR" is the file that is ultimately updated. For security and database connection issues I cannot have the SQL query on the "MASTER SAR" workbook.

Workbook

Private Sub Workbook_Open()
Call Module2.SaveSrv
End Sub

Module 1

Sub CloseRoutine()
Dim UpdateBK

Set UpdateBK = Workbooks("UPDATER")

With UpdateBK
    .Save
    .Close
End With

End Sub

Module 2

Sub SaveSrv()
Dim MasterBk As Workbook
Dim UpdateBK As Workbook
Dim MSsht As Worksheet
Dim USsht As Worksheet

Set UpdateBK = Workbooks("UPDATER")
Set USsht = UpdateBK.Worksheets("STAFF")

Application.ScreenUpdating = False

Set MasterBk = Workbooks.Open("C:\Users\amcinnes\Desktop\TOOL BOX\DEVELOPMENT\SAR MASTER")
Set MSsht = MasterBk.Worksheets("MASTER")


MSsht.Range("A2:I65536").ClearContents

With USsht
     .Range("A2:I65536").Copy Destination:=MSsht.Range("A2")
End With

With MasterBk
    .Save
    .Close
End With

On Error Resume Next
Call Module3.EMAILLIST

End Sub

Module 3

Sub EMAILLIST()

    Dim cell As Object
    Dim NR As Long
    Dim tagerror As String
    Dim Email_Send_To, Email_Send_From, Email_Subject, Email_Body As String
    Dim strUserEmail As String
    Dim strFirstClassPassword As String
    Dim errPar As String
    Dim iMsg As Object
    Dim iConfig As Object
    Dim sConfig As Variant
    Dim Row As Integer
       
    
        
    strUserEmail = "test@email.ac.uk"
    strFirstClassPassword = "password"

    Set iMsg = CreateObject("CDO.Message")
    Set iConfig = CreateObject("CDO.Configuration")
    iConfig.Load -1
    Set sConfig = iConfig.Fields
        
        With sConfig
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.0.5" 'Name or IP of remote SMTP server
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25  'Server Port
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strUserEmail
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strFirstClassPassword
            .Update
        End With
     
With Application
    .ScreenUpdating = False
    .EnableEvents = False
End With
   

 '-----------------------------------------------------------------------------

    Email_Send_To = "test@email.ac.uk"
    Email_Send_From = "test@email.ac.uk"
    Email_Subject = "SAR UPLOAD"
    Email_Body = "Please upload to replace SAR MASTER.xls"

'-----------------------------------------------------------------------------
      

    

    With iMsg
        Set .Configuration = iConfig
    End With
    
            iMsg.To = Email_Send_To
            iMsg.From = Email_Send_From
            iMsg.Subject = Email_Subject
            iMsg.Textbody = Email_Body
            iMsg.AddAttachment "C:\Users\amcinnes\Desktop\TOOL BOX\DEVELOPMENT\SAR MASTER.xls"
            iMsg.Send

          On Error GoTo tagerror


If ActiveSheet.Range("a1") = "" Then
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    Application.DisplayAlerts = True

    
Else
    Call Module1.CloseRoutine
End If

clean_up:
    With Application
       .EnableEvents = True
       .ScreenUpdating = True
    End With
        Call Module1.CloseRoutine

    
tagerror:
    MsgBox "Error: (" & Err.Number & ") " & Err.Description & " at " & Err.Source, vbCritical
    Resume clean_up
    
End Sub