G
Guest
Hi There
I wrote the following macro and this runs fine without any problems on one
machine. However I need it to run on another machine in my office but when I
try I get the following error message:
Run-time error '-2147319779 (8002801d)':
Automation error
Library not registered
Macro:
Sub auto_open()
Windows("EIS Job Log test.xls").Activate
Range("B2").Select
Dim olApp As Outlook.Application
Dim olNs As NameSpace
Dim Fldr As MAPIFolder
Dim MoveToFldr As MAPIFolder
Dim olMi As MailItem
Dim olAtt As Attachment
Dim MyPath As String
Dim i As Long
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
Set MoveToFldr = Fldr.Folders("eisreq")
MyPath = "I:\EIS\Forms\EIS Requests\"
dattim = Format(Date, "yyyymmdd") & " " & "Time-" & Format(Time, "hhmmss")
For i = Fldr.Items.Count To 1 Step -1
Range("A1").Select
rowlength = Selection.CurrentRegion.Rows.Count
Set olMi = Fldr.Items(i)
If InStr(1, olMi.Subject, "EIS_REQUEST") > 0 Then
For Each olAtt In olMi.Attachments
If olAtt.Filename = "EIS Request.xls" Then
olAtt.SaveAsFile MyPath & Fldr.Items.Count & " " &
olMi.SenderName & " " & "Date-" & dattim & ".xls"
open1 = MyPath & Fldr.Items.Count & " " &
olMi.SenderName & " " & "Date-" & dattim & ".xls"
filenm = Fldr.Items.Count & " " & olMi.SenderName & "
" & "Date-" & dattim & ".xls"
End If
Next olAtt
olMi.save
olMi.Move MoveToFldr
Workbooks.Open Filename:=open1
'copies and pastes data from eis request
Range("IR4:IV4").Select
Selection.Copy
Windows("EIS Job Log test.xls").Activate
Range("A1").Select
For x = 1 To rowlength
If ActiveCell.Cells <> "" Then
Cells(ActiveCell.Row + 1, 1).Select
End If
Next x
Selection.PasteSpecial paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
'copies and pastes filename
Range("E1").Select
For x = 1 To rowlength
If ActiveCell.Cells <> "" Then
Cells(ActiveCell.Row + 1, 6).Select
End If
Next x
ActiveCell = filenm
Windows(filenm).Activate
ActiveWorkbook.Close False
Windows("EIS Job Log test.xls").Activate
ActiveWorkbook.save
ActiveWorkbook.Close False
End If
Next i
Set olAtt = Nothing
Set olMi = Nothing
Set Fldr = Nothing
Set MoveToFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Sub
Both machines have the following ticked in the reference table.
Visual Basic for Applications
Microsoft Excel 9.0 Object Library
OLE Automation
Microsoft Office Object Library
Microsoft Outlook Object Libray
Can anyone help?
I would be extremely gratetful
Thanks in advance
Jamie
I wrote the following macro and this runs fine without any problems on one
machine. However I need it to run on another machine in my office but when I
try I get the following error message:
Run-time error '-2147319779 (8002801d)':
Automation error
Library not registered
Macro:
Sub auto_open()
Windows("EIS Job Log test.xls").Activate
Range("B2").Select
Dim olApp As Outlook.Application
Dim olNs As NameSpace
Dim Fldr As MAPIFolder
Dim MoveToFldr As MAPIFolder
Dim olMi As MailItem
Dim olAtt As Attachment
Dim MyPath As String
Dim i As Long
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
Set MoveToFldr = Fldr.Folders("eisreq")
MyPath = "I:\EIS\Forms\EIS Requests\"
dattim = Format(Date, "yyyymmdd") & " " & "Time-" & Format(Time, "hhmmss")
For i = Fldr.Items.Count To 1 Step -1
Range("A1").Select
rowlength = Selection.CurrentRegion.Rows.Count
Set olMi = Fldr.Items(i)
If InStr(1, olMi.Subject, "EIS_REQUEST") > 0 Then
For Each olAtt In olMi.Attachments
If olAtt.Filename = "EIS Request.xls" Then
olAtt.SaveAsFile MyPath & Fldr.Items.Count & " " &
olMi.SenderName & " " & "Date-" & dattim & ".xls"
open1 = MyPath & Fldr.Items.Count & " " &
olMi.SenderName & " " & "Date-" & dattim & ".xls"
filenm = Fldr.Items.Count & " " & olMi.SenderName & "
" & "Date-" & dattim & ".xls"
End If
Next olAtt
olMi.save
olMi.Move MoveToFldr
Workbooks.Open Filename:=open1
'copies and pastes data from eis request
Range("IR4:IV4").Select
Selection.Copy
Windows("EIS Job Log test.xls").Activate
Range("A1").Select
For x = 1 To rowlength
If ActiveCell.Cells <> "" Then
Cells(ActiveCell.Row + 1, 1).Select
End If
Next x
Selection.PasteSpecial paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
'copies and pastes filename
Range("E1").Select
For x = 1 To rowlength
If ActiveCell.Cells <> "" Then
Cells(ActiveCell.Row + 1, 6).Select
End If
Next x
ActiveCell = filenm
Windows(filenm).Activate
ActiveWorkbook.Close False
Windows("EIS Job Log test.xls").Activate
ActiveWorkbook.save
ActiveWorkbook.Close False
End If
Next i
Set olAtt = Nothing
Set olMi = Nothing
Set Fldr = Nothing
Set MoveToFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Sub
Both machines have the following ticked in the reference table.
Visual Basic for Applications
Microsoft Excel 9.0 Object Library
OLE Automation
Microsoft Office Object Library
Microsoft Outlook Object Libray
Can anyone help?
I would be extremely gratetful
Thanks in advance
Jamie