Outlook VBA Network file access problem - Programmers Heaven

Howdy, Stranger!

It looks like you're new here. If you want to get involved, click one of these buttons!


Welcome to the new platform of Programmer's Heaven! We apologize for the inconvenience caused, if you visited us from a broken link of the previous version. The main reason to move to a new platform is to provide more effective and collaborative experience to you all. Please feel free to experience the new platform and use its exciting features. Contact us for any issue that you need to get clarified. We are more than happy to help you.

Outlook VBA Network file access problem

aidanm79aidanm79 Posts: 1Member
Hi Guys,

I have a problem running the following code when the file path is pointed at a mapped network drive location. It runs perfectly when pointed at my core drive but I have to run it over a network!! The code runs to this line and then exits without error!

oWB.Worksheets(strSheetName).Cells(theRow + 1, 2).Value = Mid(Item.Body, lLen + lRmsNo, 5)

I am using XP SP3 Outlook 2003 VBA 6.5 (nope, can't change this selection!)

Any ideas would be appreciated:

Sub SetRAMS(ByVal Item As Object)

Dim strPath As String
Dim strSheetName As String
Dim aRng As Range
Dim oExcel As Excel.Application
Dim oWB As Workbook
Dim xlSht As Excel.Worksheet
Dim myOlMItem As Outlook.MailItem
Dim strName As String
Dim lLen As Long
Dim lLenNxt As Long
Dim strRmNo As String
Dim strRmLoc As String
Dim strRmDet As String
Dim strTemp As String
Dim rngCell As Range
Dim rngTmp As Range

Dim lRmsNo As Long 'RAMS no offset
Dim lRmDes As Long 'RAMS description offset
Dim lRmLoc As Long 'RAMS physical location offset
Dim lLenTot As Long 'Body string total length

Dim theRow As Variant

lRmsNo = Len("New RAMS Request: R0")
lRmDes = Len("Details: ")
lRmLoc = Len("In Relation to: ")

strRmNo = "New RAMS Request: R0"
strRmDet = "Details: "
strRmLoc = "In Relation to: "

lLenTot = Len(Item.Body)

strSheetName = "Sheet1"

strPath = "G:WorksRAMS TEMP.xls"

Set oExcel = New Excel.Application

' On Error GoTo error_now:

Set oWB = oExcel.Workbooks.Open(strPath, 2, False)


theRow = oWB.Worksheets(strSheetName).Cells(1, 2).End(xlDown).Row

lLen = InStr(1, Item.Body, strRmNo, vbTextCompare)

oWB.Worksheets(strSheetName).Cells(theRow + 1, 2).Value = Mid(Item.Body, lLen + lRmsNo, 5)

lLen = InStr(1, Item.Body, strRmDet, vbTextCompare)
lLenNxt = (lLen - InStr(1, Item.Body, strRmLoc, vbTextCompare)) - lRmLoc
lLen = InStr(1, Item.Body, strRmLoc, vbTextCompare)

oWB.Worksheets(strSheetName).Cells(theRow + 1, 4).Value = Mid(Item.Body, lLen + lRmLoc, lLenNxt)

lLen = InStr(1, Item.Body, strRmDet, vbTextCompare)

oWB.Worksheets(strSheetName).Cells(theRow + 1, 3).Value = Mid(Item.Body, lLen + lRmDes, lLenTot - lLen)
oWB.Worksheets(strSheetName).Cells(theRow + 1, 1).RowHeight = 12


Set oExcel = Nothing
Set oWB = Nothing

Exit Sub

Thanks in advance


Sign In or Register to comment.