خُب این خطا داره بهت میگه که سابروتین یا فانکشن fPrintFile تعریف نشده
دلیلش هم اینه که شما فقط از فانکشن PrintFiles استفاده می کنی و فانکشن fPrintFile با بقیه کدها رو در ماژول حذف کرده ای
به کدهای پست 5 عنایت داشته باش
بنده در پست 6 عرض کردم که تابع اصلاح شده PrintFiles رو جایگزین تابع قبلی کنی نه اینکه از بقیه کدها استفاده نکنی
همه کدها:
Private Declare Function apiShellExecute Lib "shell32.dll" _
Alias "ShellExecuteA" _
(ByVal hwnd As Long, _
ByVal lpOperation As String, _
ByVal lpFile As String, _
ByVal lpParameters As String, _
ByVal lpDirectory As String, _
ByVal nShowCmd As Long) _
As Long
'***App Window Constants***
Public Const WIN_NORMAL = 1 'Open Normal
Public Const WIN_MAX = 3 'Open Maximized
Public Const WIN_MIN = 2 'Open Minimized
Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&
Public Function fPrintFile(stFile As String)
Dim lRet As Long, varTaskID As Variant
Dim stRet As String
lRet = apiShellExecute(hWndAccessApp, "print", stFile, vbNullString, vbNullString, 0&)
If lRet > ERROR_SUCCESS Then
stRet = vbNullString
lRet = -1
Else
Select Case lRet
Case ERROR_NO_ASSOC:
stRet = "Error: No associated application. Couldn't print!"
Case ERROR_OUT_OF_MEM:
stRet = "Error: Out of Memory/Resources. Couldn't print!"
Case ERROR_FILE_NOT_FOUND:
stRet = "Error: File not found. Couldn't print!"
Case ERROR_PATH_NOT_FOUND:
stRet = "Error: Path not found. Couldn't print!"
Case ERROR_BAD_FORMAT:
stRet = "Error: Bad File Format. Couldn't print!"
Case Else:
End Select
End If
fPrintFile = lRet & IIf(stRet = "", vbNullString, ", " & stRet)
End Function
Public Function PrintFiles(FolderPath, fileName As String)
On Error GoTo Err
Dim fsObj, FD, Fs, Fl 'Folder, Files collection, File
Dim FullPath As String
Set fsObj = CreateObject("Scripting.FileSystemObject")
Set FD = fsObj.GetFolder(FolderPath)
Set Fs = FD.Files
For Each Fl In Fs
If Fl.Name = fileName Then
FullPath = FolderPath & "\" & Fl.Name
fPrintFile (FullPath)
End If
Next
Set fsObj = Nothing
Set FD = Nothing
Set Fs = Nothing
Err:
Select Case Err.Number
Case 76
MsgBox "! مسير پوشه پيدا نشد"
Case Else:
End Select
End Function
پاسخ با نقل قول