Import data from outlook

[steveallany2k6]

i currently have a spreedsheet which imports data from outlook mail box to the spreed sheet and then the sheet is linked to a table in access. is it possible for me to import the data directly to access leaving excel out of the equation.

this is the code in excel if it helps anyone

Sub impETM()
Sheets("Adjustments").Select
Cells.Select
Selection.Delete Shift:=xlUp
Range("A1").Select
Sheets("Sheet1").Select
' Variable Declaration
Dim ns As NameSpace
Dim Inbox As MAPIFolder, user As String
Dim olookSpace As Outlook.NameSpace
Dim olookRecipient As Outlook.Recipient
Dim AllowedAcc As Outlook.Views
Dim i As Integer
 
Set ns = GetNamespace("MAPI")
Set Inbox = ns.GetDefaultFolder(olFolderInbox)
i = 0
 
If Inbox.Items.Count = 0 Then
MsgBox "There are no messages in the Inbox.", vbInformation, _
"Nothing Found"
Exit Sub
End If
 
Application.ScreenUpdating = False
Cells.Delete
Application.Calculation = xlCalculationManual
Set olookRecipient = ns.CreateRecipient("PENSION SERVICE TVP IPC STAR TEAM")
Set Inbox = ns.GetSharedDefaultFolder(olookRecipient, olFolderInbox)
Set adbox = Inbox.Folders("Requests")
Set outBox = Inbox.Folders("Requests")
mails = adbox.Items.Count
i = 0: mail = -1
' Extract Email Information
Do While i < mails
i = i + 1
With adbox.Items(i)
'set allowed
mail = mail + 1
Cells(mail + 1, 1).Formula = .SenderName
Cells(mail + 1, 2).Formula = .Body
'.Move (outBox)
End With
Loop
' Clean Up
Set adbox = Nothing
Cells.Columns.AutoFit
Cells.Rows.AutoFit
[A1].Select
With Application
.Calculation = xlCalculationAutomatic
End With
Dim k As Integer
Dim foundRow As Boolean
k = 1
Worksheets("Sheet1").Select
Do While foundRow = False
If Cells(k, 1).Value = "" Then
Cells(k, 2) = "stop"
foundRow = True
Else: k = k + 1
End If
Loop
Cells(1, 1).Select
Cells.Select
Range("A76").Activate
Selection.Replace What:="1/1/4501", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Selection.Replace What:="=", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
Cells(1, 1).Select
Cells(1, 26).Value = k
Application.Run "'Flexi Import.xls'!sortAdjusts"
End Sub

 

[namliam]

Yes offcourse you can, the code can just be copy/paste into access...
But you need to replace the writing into excel by writing into a table.

Please use [ code ] and [/ code ] without the spaces around code when you post code.
Your current post is allmost unreadable!

 

[steveallany2k6]

Sorry

Sorry bout that im all new to this.

so what bits would i have to change in the code to make it work?

as i mentioned i am new to all this and any help would be great

Cheers

 

[namliam]

Your code is still unreadable, because it is not indented. Hopefully your 'real' code is indented.

The basic idea would be to take all the references to excel cells (i.e. Cells(mail + 1, 1).Formula) and change that to table references.

To open a table and add records to it:
Dim rs as dao.recordset
Set rs = Currentdb.openrecordset("Select * from tablename" )
rs.addnew ' add new record
rs!Fieldname1 = emailvalue1
rs!Fieldname2 = emailvalue2
rs.update

Good luck!

 

[steveallany2k6]

Thank You

I Shall give that a try

Thanks