Hi there,

I'm having some trouble with the rather long code below.

It works perfectly fine but I want to change the following sections to
simply copy the file instead of opening and then saving:

objMsg.Display
ActiveWorkbook.SaveAs (MyFile)
ActiveWorkbook.Close

This is used in an Excel template and is designed to copy a fresh/new
template from an Outlook public folder into the users My Documents
folder in case of corruption/updates. There's no other way of doing
this as we have limited software etc.

Basically I have kept the Outlook variables as Objects as we use
different versions of Office (bloody annoying, I know) so this avoids
reference errors for users.

So far I've played around with variations of "objMsg.SaveAsFile MyFile
& objMsg" including Copy, Move and so on but can't seem to get my head
around it.

The full code is below, grateful for any assistance.


Dim objOL As Object
Dim objMsg As Object
Dim oFolder As Object
Dim i As Long, n As Long
Dim iCount As Integer
Dim mypath As String, MyFile As String, sfile As String
Dim fs As New FileSearch
Dim Test As String

Application.DisplayAlerts = False
Application.ScreenUpdating = False

mypath = GetTemporaryDirectory
MyFile = GetFile

'Use current Outlook object or create if none exist
Dim olApp As Object
Dim olNs As Object

Set olApp = GetObject(, "Outlook.Application")

If Err.Number = 429 Then
Set olApp = CreateObject("Outlook.application")
End If

Set oFolder = GetFolder(GetNetworkPath)

If Not oFolder Is Nothing Then
If oFolder.Items.Count = 0 Then
MsgBox ("Addins Folder is empty, please contact the
EoSR team"), , ("No files found")
Exit Sub
Else
i = 1
iCount = 0
For i = oFolder.Items.Count To 1 Step -1 ' loop
through all items in the Public Folder
Set objMsg = oFolder.Items(i)
If InStr(1, objMsg.Subject, "Queue",
vbTextCompare) Then

If objMsg.Attachments.Count 0 Then

With fs
.LookIn = mypath
.SearchSubFolders = True
.fileName = "*Queue*"
If .Execute 0 Then

For n = 1 To .FoundFiles.Count
sfile =
FileNameOnly(.FoundFiles(n))

Test = MsgBox(Right$(sfile, 10)
= Right$(objMsg.Subject, 10))

If Right$(sfile, 10) = Right$
(objMsg.Subject, 10) Then
If MsgBox("Existing
template matches latest version" & vbNewLine _
& vbNewLine & "If existing
template is functioning incorrectly, installing a fresh version may
solve the issue" _
& vbNewLine & vbNewLine &
"Install a fresh version?", vbYesNo, "Update") = vbYes Then

KillProperly .FoundFiles(i)
objMsg.Display
ActiveWorkbook.SaveAs
(MyFile)
ActiveWorkbook.Close
MsgBox "Old template
removed, New version installed to " & mypath, , "Update"
Call
Shell("explorer.exe " & mypath, vbNormalFocus)
Else
MsgBox "The template has
not been changed", , "Unchanged"
End If
Else
MsgBox "New version
detected, preparing to replace old version", , "Update"

KillProperly .FoundFiles(n)
objMsg.Display
ActiveWorkbook.SaveAs
(MyFile)
ActiveWorkbook.Close
MsgBox "Old template
removed, New version installed to " & mypath, , "Update"
Call Shell("explorer.exe "
& mypath, vbNormalFocus)
End If
Next
Else
MsgBox "No template detected,
preparing to install new version", , "Update"

' objMsg.Display
' ActiveWorkbook.SaveAs
(MyFile)

objMsg.SaveAsFile MyFile &
objMsg

ActiveWorkbook.Close
MsgBox "New EoSR installed to
" & mypath, , "Update"
Call Shell("explorer.exe " &
mypath, vbNormalFocus)
End If
End With
End If
End If
Next i
End If
Else
MsgBox "Could not find file or folder", , "Error"
End If
End If

Set objMsg = Nothing
Set objOL = Nothing
Set oFolder = Nothing

Application.DisplayAlerts = True
Application.ScreenUpdating = True