Allans thanks for pointing me the right direction.
Below is my final code
It runs this on all emails in the inbox:
Copies the body of the email to to seperate new excel fromat files in a set
directory.
Deattaches all attachment to a directory
Makes a file of the all emails file name which were converted. This file is
then used to bring all the above data back together in one data base.
Thanks for your help
Hvae a good day
Sub SetupALL()
' work on this one for excel.
Dim ns As NameSpace
Dim Inbox As MAPIFolder
Dim Item As Object
Dim Atmt As Attachment
Dim FileName As String
Dim i As Integer
Dim test As Integer
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
i = 0
test = 0
Dim objItem As Object
Dim MyItem1 As Outlook.Inspector
Dim strPath As String
Dim ExcelApp As Object
Dim ExcelSheet As Object
Dim olApp As New Outlook.Application
Dim doc As Object
test = 1
'strPath = "D:\temp\_MyExcelDoc.xls"
'strPath = "G:\Alcatel\Outside_Plant_Records\DBYD\Temp\_MyExcelDoc.xls"
strPath = "M:\Alcatel\Outside_Plant_Records\DBYD\Temp\_MyExcelDoc.xls"
Set ExcelApp = CreateObject("Excel.Application")
Set ExcelSheet = ExcelApp.Workbooks.Add
For Each Item In Inbox.Items
strname = Item.Subject
ExcelSheet.ActiveSheet.Cells(test, 1).Value = Mid(strname, 5, 7)
'Item.SaveAs "d:\temp\" & Mid(strname, 5, 7) & ".xls", olTXT
'Item.SaveAs "G:\Alcatel\Outside_Plant_Records\DBYD\Temp\" &
Mid(strname, 5, 7) & ".xls", olTXT
Item.SaveAs "M:\Alcatel\Outside_Plant_Records\DBYD\Temp\" & Mid(strname,
5, 7) & ".xls", olTXT
test = test + 1
i = i + 1
Next Item
ExcelSheet.SaveAs strPath
ExcelApp.Quit
Set ExcelApp = Nothing
For Each Item In Inbox.Items
For Each Atmt In Item.Attachments
'FileName = "D:\temp\" & Atmt.FileName
'FileName = "G:\Alcatel\Outside_Plant_Records\DBYD\Notification\" &
Atmt.FileName
FileName = "M:\Alcatel\Outside_Plant_Records\DBYD\Notification\" &
Atmt.FileName
Atmt.SaveAsFile FileName
i = i + 1
Next Atmt
Next Item
End Sub
"Alan" wrote:
> "Neil1958" <(E-Mail Removed)> wrote in message
> news:BF6D2D79-B10F-46EF-81D4-(E-Mail Removed)...
> >
> > The saving of the actual email is still a question.
> > A bit of back ground
> > I receive an email in the same format each time and from the same
> > source.
> > I copy the body of the email into an excel sheet. By using the copy
> > and paste function then excel automatically convert all the info
> > into excel format.
> > The data is then converted into one line in a database
> automatically.
> >
> > Is there a Marco to save the email? As you would do manually with
> > "File" and "Save" from the menu. Like the attachment save macro you
> > sent me.
> >
> > If not then what would be the Marco to copy the content of the email
> > ready to paste.
> > I use Ctrl/A and then Ctrl/C, from that I paste it into the excel
> > clean up file directly as text.
> >
> > Then the macro can detach the attachments and I would have the email
> > content ready yo paste into excel. I already have the macro in excel
> > which takes it from the paste step through all the rest.
> >
>
> Hi Neil,
>
> You can select multiple emails, the do File - Save (chose a path /
> name) and save them all as a single text file.
>
> Does that do what you need, or are you really needing to have copied
> the text in the emails to the clipboard?
>
> If the latter, then I am not sure. You can copy text in VBA, but I
> cannot get it to then paste to excel automagically.
>
> Perhaps I am missing something really obvious here! Perhaps the excel
> app needs to exist as an object in the outlook app and / or vice versa
> for it to work? I am not up on that kind of thing.
>
> Alan.
>
>
>
>
>
|
Similar Threads
