Makro fejl i makroen der skal oprette mails

Jeg har et problem med en makro som  bak  har stået fader til, den er på to forskellige PC-er en i A (min) og en i E begge PC-er har samme Windows og programmer.

SendAutoMail har i lang tid virket perfekt, men pludselig vil SendAutoMail ikke virke i E, den vil ikke oprette en mail til de enkelte firmaer og lægge dem ind i Outlook, den stopper ved:

If GetValue(FilePath, v(UBound(v)), sheet, Cell2Get) > 0 Then

Jeg har taget en kopi af filen SendAutoMail og tilhørende mapper hos E og lagt dem på min egen PC A, her virker det uden nogen fejl. Er der nogen der kan hjælpe?

johnfm


Function CreateMail(astrRecip As Variant, _
                  astrCCpers As Variant, _
                  strSubject As String, _
                  strMessage As String, _
                  Optional astrAttachments As Variant) As Boolean

  Dim olApp                As Outlook.Application
  Dim objNewMail            As Outlook.MailItem
  Dim varAttach            As Variant
  Dim blnResolveSuccess    As Boolean

  On Error GoTo CreateMail_Err

  Set olApp = New Outlook.Application
  Set myNameSpace = olApp.GetNamespace("MAPI")
  Set myFolder = myNameSpace.GetDefaultFolder(olFolderDrafts)
  Set objNewMail = olApp.CreateItem(olMailItem)

  With objNewMail
      .Recipients.Add (astrRecip)
      If Not astrCCpers = "" Then
        Set test = .Recipients.Add(astrCCpers)
        test.Type = olCC
      End If
      For Each varAttach In astrAttachments
        If Not IsEmpty(varAttach) Then .Attachments.Add varAttach
      Next varAttach
      .Subject = strSubject
      .Body = strMessage
   
      .Save    '.Send
     
  End With

  CreateMail = True

CreateMail_End:
  Exit Function
CreateMail_Err:
  CreateMail = False
 
  Resume CreateMail_End
End Function

Sub BatchProcess()
Dim FS As FileSearch
Dim FilePath As String, FilePathStart As String
Dim i As Integer, j As Integer
Dim v As Variant
Dim C As Range, rgFCell As Range
Dim Firmaer As Range
Dim Cell2Get
Const sheet As String = "Opgørelse"

With ThisWorkbook.Sheets(1)
    Set Firmaer = .Range("A2:A" & .Range("A65536").End(xlUp).Row)
End With
FilePathStart = ThisWorkbook.path
Cell2Get = "B8"
Application.ScreenUpdating = False
Set FS = Application.FileSearch
For Each C In Range("F1:M1")
    With FS
        .NewSearch                                                         
        .LookIn = FilePathStart & "\" & C & "\"
        .FileType = msoFileTypeExcelWorkbooks             
        .SearchSubFolders = False
        .Execute
        If .FoundFiles.Count = 0 Then GoTo Igen
        For i = 1 To .FoundFiles.Count
            v = Split(.FoundFiles(i), Application.PathSeparator)
            FilePath = Left(.FoundFiles(i), InStrRev(.FoundFiles(i), Application.PathSeparator))
            If GetValue(FilePath, v(UBound(v)), sheet, Cell2Get) > 0 Then
                For Each rgFCell In Firmaer
                    If UCase(v(UBound(v))) Like "??" & UCase(rgFCell & "200?.xls") Then
                        Cells(rgFCell.Row, C.Column) = .FoundFiles(i)
                        Exit For
                    End If
                Next
            End If
        Next i
    End With
Igen:
Next
End Sub


Private Function GetValue(path, file, sheet, range_ref)
Dim arg As String
arg = "'" & path & "[" & file & "]" & sheet & "'!" & Range(range_ref).Range("A1").Address(, , xlR1C1)
GetValue = ExecuteExcel4Macro(arg)
End Function


Sub Main()
Dim vfiler
Dim x As Boolean
Dim C As Range
BatchProcess
For Each C In Range("B2:B" & Range("B65536").End(xlUp).Row)
    vfiler = Range("F" & C.Row, "O" & C.Row)
    x = CreateMail(C.Value, C.Offset(0, 1), C.Offset(0, 2), C.Offset(0, 3), vfiler) 'ændret
    If x = False Then MsgBox C.Value & "  ikke oprettet"
Next
End Sub