"File not found" Excel VBA

Question

I have issue with my code. I did automatized form for a some requests in our company. I tested my code and everything goes well. My one colleague try use it but, excel showed msg "File not found".

Can you help me? I dont know what is a problem, because other colleague has no problem with this code.

Sub CommandButton1_Click()

id_request = Format(Now(), "yyyymmddHhNnSs")

date_year = Format(Now(), "yyyy")
date_month = Format(Now(), "mm")

Dim product As Variant
product = Range("H5").Value

Dim termin As Variant
termin = Range("H17").Value

Dim saveLocation As String

' Podmienka pre ukladania na zaklade mesiacov
If date_month = "01" Then
    saveLocation = "\\xx.xx.xxx.xxx\Skupiny\_INFO\NM-PRILOHY-HPDC\" & date_year & "\01-Január\NM_" & product & "_" & id_request & ".pdf"
    ElseIf date_month = "02" Then
    saveLocation = "\\xx.xx.xxx.xxx\Skupiny\_INFO\NM-PRILOHY-HPDC\" & date_year & "\02-Február\NM_" & product & "_" & id_request & ".pdf"
    ElseIf date_month = "03" Then
    saveLocation = "\\xx.xx.xxx.xxx\Skupiny\_INFO\NM-PRILOHY-HPDC\" & date_year & "\03-Marec\NM_" & product & "_" & id_request & ".pdf"
    ElseIf date_month = "04" Then
    saveLocation = "\\xx.xx.xxx.xxx\Skupiny\_INFO\NM-PRILOHY-HPDC\" & date_year & "\04-Apríl\NM_" & product & "_" & id_request & ".pdf"
    ElseIf date_month = "05" Then
    saveLocation = "\\xx.xx.xxx.xxx\Skupiny\_INFO\NM-PRILOHY-HPDC\" & date_year & "\05-Máj\NM_" & product & "_" & id_request & ".pdf"
    ElseIf date_month = "06" Then
    saveLocation = "\\xx.xx.xxx.xxx\Skupiny\_INFO\NM-PRILOHY-HPDC\" & date_year & "\06-Jún\NM_" & product & "_" & id_request & ".pdf"
    ElseIf date_month = "07" Then
    saveLocation = "\\xx.xx.xxx.xxx\Skupiny\_INFO\NM-PRILOHY-HPDC\" & date_year & "\07-Júl\NM_" & product & "_" & id_request & ".pdf"
    ElseIf date_month = "08" Then
    saveLocation = "\\xx.xx.xxx.xxx\Skupiny\_INFO\NM-PRILOHY-HPDC\" & date_year & "\08-August\NM_" & product & "_" & id_request & ".pdf"
    ElseIf date_month = "09" Then
    saveLocation = "\\xx.xx.xxx.xxx\Skupiny\_INFO\NM-PRILOHY-HPDC\" & date_year & "\09-September\NM_" & product & "_" & id_request & ".pdf"
    ElseIf date_month = "10" Then
    saveLocation = "\\xx.xx.xxx.xxx\Skupiny\_INFO\NM-PRILOHY-HPDC\" & date_year & "\10-Október\NM_" & product & "_" & id_request & ".pdf"
    ElseIf date_month = "11" Then
    saveLocation = "\\xx.xx.xxx.xxx\Skupiny\_INFO\NM-PRILOHY-HPDC\" & date_year & "\11-November\NM_" & product & "_" & id_request & ".pdf"
    ElseIf date_month = "12" Then
    saveLocation = "\\xx.xx.xxx.xxx\Skupiny\_INFO\NM-PRILOHY-HPDC\" & date_year & "\12-December\NM_" & product & "_" & id_request & ".pdf"
    Else
    saveLocation = "\\xx.xx.xxx.xxx\Skupiny\_INFO\NM-PRILOHY-HPDC\" & date_year & "\NM_" & product & "_" & id_request & ".pdf"
End If

  Dim IsCreated As Boolean
  Dim i As Long
  Dim PdfFile As String, Title As String
  Dim OutlApp As Object
 
  Title = Range("A1")
 
  ' Define PDF filename
  PdfFile = ActiveWorkbook.FullName
  i = InStrRev(PdfFile, ".")
  If i > 1 Then PdfFile = Left(PdfFile, i - 1)
  PdfFile = "NM_" & product & "_" & id_request & ".pdf"
 
  ' Export activesheet as PDF
  With ActiveSheet
    .ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, From:=1, To:=1, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
  End With
 
  ' Use already open Outlook if possible
  On Error Resume Next
  Set OutlApp = GetObject(, "Outlook.Application")
  If Err Then
    Set OutlApp = CreateObject("Outlook.Application")
    IsCreated = True
  End If
  OutlApp.Visible = True
  On Error GoTo 0
 
  ' Prepare e-mail with PDF attachment
  With OutlApp.CreateItem(0)
   
    ' Prepare e-mail
    .Subject = "* Žiadosť o neplánované meranie - " & product
    .To = "xxx"
    .CC = "xxx"
    .Body = "Zdravím," & vbLf & vbLf _
          & "Poprosím vás o vykonanie neplánovaného merania." & vbLf _
          & "Termín: " & termin & vbLf _
          & "Číslo žiadosti: " & id_request & vbLf & vbLf _
          & "Cesta k NM: " & saveLocation & vbLf & vbLf _
          & "S pozdravom," & vbLf _
          & Application.UserName & vbLf & vbLf
    .Attachments.Add PdfFile
   
    ' Try to send
    On Error Resume Next
    .Send
    Application.Visible = True
    If Err Then
      MsgBox "POZOR ! Nastala chyba, žiadosť nebola odoslaná. Kontaktujte nás", vbExclamation
    Else
      MsgBox "Žiadosť bola odoslaná, dokument sa o chvíľu zatvorí", vbInformation
    End If
    On Error GoTo 0
   
  End With
 
  ' Delete PDF file
  Kill PdfFile
 
  ' Quit Outlook if it was created by this code
  If IsCreated Then OutlApp.Quit
 
  ' Release the memory of object variable
  Set OutlApp = Nothing

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, From:=1, To:=1, _
    Filename:=saveLocation
    
ActiveWorkbook.Close SaveChanges:=False

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

Many thanks in advance

Answer 1

Not sure which line is giving you the problem but in PdfFile = "NM_" & product & "_" & id_request & ".pdf", I see no path for the file? So .Attachments.Add PdfFile and Kill PdfFile may give you a problem.

Try this

Change

PdfFile = ActiveWorkbook.FullName
i = InStrRev(PdfFile, ".")
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = "NM_" & Product & "_" & id_request & ".pdf"

to

Dim sFilePath As String
PdfFile = ActiveWorkbook.FullName
sFilePath = GetDirectoryFromPathFilename(PdfFile)
PdfFile = sFilePath & "NM_" & Product & "_" & id_request & ".pdf"

and paste this function right at the bottom. The below function extracts the directory part from the full Folder-File path. For example GetDirectoryFromPathFilename("C:\AAA\BB.Pdf") will give you C:\AAA\

Private Function GetDirectoryFromPathFilename(strPath As String) As String
    Dim pos As Integer
    pos = InStrRev(strPath, "\")
    If pos > 0 Then
        GetDirectoryFromPathFilename = Left$(strPath, pos)
    Else
        GetDirectoryFromPathFilename = ""
    End If
End Function