Copy item from Outlook to folder via Excel

[Andy]

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

 

[GS]

Is there some reason you can't do this in Outlook and simply save to a
text file? Seems to be a pretty long-way-round to do this in Excel!

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[Andy]

Garry,

It's part of a template that will be filled out by many users so I assumed it would be easier to build it into the template.

I'm not sure what the text file would be used for? A link to the Outlook code?

 

[GS]

Andy submitted this idea :

Garry,

It's part of a template that will be filled out by many users so I assumed it
would be easier to build it into the template.

I'm not sure what the text file would be used for? A link to the Outlook
code?

The text file idea is just a suggested alternative to using an Excel
file because it would take up considerably less disk space per message
stored. OR, were you thinking to store many messages in a single Excel
file?

Not sure what you mean by a 'template'. Outlook has the same VBA
capability as Excel and so I'm curious why you're not using an
Outlook-based solution to perform an Outlook-based task...

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[Andy]

The template is essentially a form based spreadsheet system for users to submit various types of data and so it makes sense to be built in Excel.
The Outlook section is only a tiny part of the code, used to simply "download" another version of the template.

I'm just trying to encompass everything in the same workbook. I've done something similar before and it worked perfectly. It only seems to be the different version of Office issue that throws a spanner in the works.

 

[GS]

Andy wrote :

The template is essentially a form based spreadsheet system for users to
submit various types of data and so it makes sense to be built in Excel. The
Outlook section is only a tiny part of the code, used to simply "download"
another version of the template.

I'm just trying to encompass everything in the same workbook. I've done
something similar before and it worked perfectly. It only seems to be the
different version of Office issue that throws a spanner in the works.

Doesn't sound to me that you're implementing normal use of an Excel
template. Not sure what you mean by "download" another version of the
template but templates are used to either insert worksheets into an
open workbook OR open a new workbook based on the template. Perhaps you
need to review the ActiveWorkbook.Sheets.Add method OR the Template
parameter of the Workbooks.Open method!

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[Andy]

The workbook is simply a means for many users to input data. It will be saved on their personal drives. That's it basically. In case the workbook breaks I want to include a button so that they can simply copy a new unbroken version from the Outlook public folder to their My Documents folder.

 

[GS]

Try using the 'FileCopy' statement...

FileCopy Source:=oFolder.Items(i), Destination:=<NewPathAndFilename>

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[Andy]

Thanks Garry.

It appears to find the file as the filename is correct and the i shows as 1 but I still get the error "File not found" even though I know it's there...

 

[GS]

Andy formulated the question :

Thanks Garry.

It appears to find the file as the filename is correct and the i shows as 1
but I still get the error "File not found" even though I know it's there...

Possibly.., it might be a problem with how you're accessing the folder
and its files. (It's not clear what GetFolder() does) Look at using
VB's Dir() function instead. you might be having an Outlook version
issue with the code syntax. OR, 'Source:=oFolder.Items(i)' may not be
returning an actual filename. You can check this by stepping through
the code and hovering your mouse pointer over the text to see what
value is returned. Note that FileCopy requires a full path and filename
for both parameters!

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[Andy]

GetFolder explores the folder structure and returns the last folder name via:

"Public Function GetFolder(strFolderPath As String) As Object

Dim objApp As Object
Dim objNS As Object
Dim colFolders As Object
Dim oFolder As Object
Dim arrFolders() As String
Dim i As Long
On Error Resume Next

strFolderPath = Replace(strFolderPath, "/", "\")
arrFolders() = Split(strFolderPath, "\")

Set objApp = GetObject("", "Outlook.Application")
Set objNS = objApp.GetNamespace("MAPI")
Set oFolder = objNS.Folders.Item(arrFolders(0))
If Not oFolder Is Nothing Then
For i = 1 To UBound(arrFolders)
Set colFolders = oFolder.Folders
Set oFolder = Nothing
Set oFolder = colFolders.Item(arrFolders(i))
If oFolder Is Nothing Then
Exit For
End If
Next
End If

Set GetFolder = oFolder
Set colFolders = Nothing
Set objNS = Nothing
Set objApp = Nothing
End Function"


I've tried "FileCopy Source:=oFolder & objMsg, Destination:=mypath & objMsg" but still no file can be found. Interestingly it shows "File not found" and if i change oFolder & objMsg to oFolder & "\" & objMsg it shows "Path not found". I guessed that there is a fault with the file name but it shows as it should through objmsg...

The filepath is "Public Folders\All Public Folders\Queue\New Template" and oFolder returns "New Template" ObjMsg returns the correct filename, mypath returns the correct G drive path.

I've tried variations of the below with no joy, and I can't think of an alternative to Dir as that is only for windows file structure, not outlook as far as I know?

FileCopy Source:="Public Folders\All Public Folders\Queue\New Template\" & objMsg, Destination:=mypath & objMsg"

 

[GS]

Okay, I think I see the problem! You're referencing Outlook folders,
not file folders. I'm not sure when I mentioned that CopyFile needs a
full path and filename for both parameters that it didn't occur to you
that you are dealing with email messages instead of files.

I still think I'd be doing this in an Outlook VBA project rather than
Excel, even if I had to automate Excel for part of the process. Though,
I'm sure whatever you use the Excel form template for that it can be
duplicated in a userform that runs within Outlook.

--
Garry

Free usenet access at http://www.eternal-september.org
ClassicVB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

 

[Andy]

I'm fully aware that I'm trying to move something from an outlook public folder to a file folder and that the file, even though an Excel file would be treated as an outlook item but I assumed that it could still be done.

I've previously used:
objMsg.Display
ActiveWorkbook.SaveAs (MyFile)

which has exactly the same outcome but I was hoping for a version that avoids having to open the file first.

Redoing this in Outlook isn't an option due to time limitations. In fact I'll likely have to leave this feature until a later update.

Thanks for the help anyway!