چاپ فایل [بایگانی] - برنامه نویس

محمد رضا بهبودی

سه شنبه 07 اسفند 1403, 14:18 عصر

با سلام و احترام خدمت اساتید محترم
می خواستم بپرسم با چه کدی می توانم یک فایل موجود در یک پوشه را مستقیما چاپ کنم ، بدون باز کردن فایل
یعنی مستقیم فایل را برای پرینتر ارسال کنم
ممنون

amirzazadeh

سه شنبه 07 اسفند 1403, 17:06 عصر

با سلام و احترام خدمت اساتید محترم
می خواستم بپرسم با چه کدی می توانم یک فایل موجود در یک پوشه را مستقیما چاپ کنم ، بدون باز کردن فایل
یعنی مستقیم فایل را برای پرینتر ارسال کنم
ممنون
سلام از این لینک کمک بگیرید:
https://www.access-programmers.co.uk/forums/threads/vba-to-print-all-files-in-a-folder.294370/

محمد رضا بهبودی

چهارشنبه 08 اسفند 1403, 09:22 صبح

سلام از این لینک کمک بگیرید:
https://www.access-programmers.co.uk/forums/threads/vba-to-print-all-files-in-a-folder.294370/
سلام وقت بخیر
استاد گرامی
متاسفانه نتونستم استفاده کنم .
اگر امکان داره لطفا راهنمایی بیشتری بفرمائید
ممنون

eb_1345

چهارشنبه 08 اسفند 1403, 12:46 عصر

سلام وقت بخیر
استاد گرامی
متاسفانه نتونستم استفاده کنم .
اگر امکان داره لطفا راهنمایی بیشتری بفرمائید
ممنون

با سلام و وقت بخیر !
بصورت زیر عمل کن ببین نتیجه می گیرین:
کدهای زیر رو در یک ماژول عمومی قرار بده:

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(FolderName)
Dim NameOfFile, fsObj, FD, Fs, Fl 'Folder, Files collection, File
Dim DB As DAO.Database, FullPath As String
Set fsObj = CreateObject("Scripting.FileSystemObject")
Set FD = fsObj.GetFolder(FolderName)
Set Fs = FD.Files
Set DB = CurrentDb()
For Each Fl In Fs
NameOfFile = Fl.Name
FullPath = FolderName & "\" & NameOfFile
fPrintFile (FullPath)
Next
Set fsObj = Nothing
Set FD = Nothing
Set Fs = Nothing
End Function

بعد با این فرض که پوشه شما با نام فولد folder1 در درایو E قرار دارد از کد زیر برای چاپ فایل موجود در پوشه فوق استفاده کن :

Call PrintFiles("E:\folder1")

محمد رضا بهبودی

پنج شنبه 09 اسفند 1403, 09:22 صبح

با سلام و وقت بخیر !
بصورت زیر عمل کن ببین نتیجه می گیرین:
کدهای زیر رو در یک ماژول عمومی قرار بده:

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(FolderName)
Dim NameOfFile, fsObj, FD, Fs, Fl 'Folder, Files collection, File
Dim DB As DAO.Database, FullPath As String
Set fsObj = CreateObject("Scripting.FileSystemObject")
Set FD = fsObj.GetFolder(FolderName)
Set Fs = FD.Files
Set DB = CurrentDb()
For Each Fl In Fs
NameOfFile = Fl.Name
FullPath = FolderName & "\" & NameOfFile
fPrintFile (FullPath)
Next
Set fsObj = Nothing
Set FD = Nothing
Set Fs = Nothing
End Function

بعد با این فرض که پوشه شما با نام فولد folder1 در درایو E قرار دارد از کد زیر برای چاپ فایل موجود در پوشه فوق استفاده کن :

Call PrintFiles("E:\folder1")

با سلام و احترام
استاد گرانقدر
مشکل اینجاست که در پوشه مورد نظر بیش از یک فایل وجود دارد و من فقط می خوام یکی از فایلها را پرینت بگیرم.
لطفا در صورت امکان راهنمائی بفرمائید

eb_1345

پنج شنبه 09 اسفند 1403, 13:41 عصر

با سلام و احترام
استاد گرانقدر
مشکل اینجاست که در پوشه مورد نظر بیش از یک فایل وجود دارد و من فقط می خوام یکی از فایلها را پرینت بگیرم.
لطفا در صورت امکان راهنمائی بفرمائید
با سلام مجدد
برای این کار میتونید در تابع PrintFiles شرط بذارید که اگر نام فایل مساوی نام فایل مورد نظر شما بود چاپ انجام بشه:
تابع اصلاح شده زیر رو جایگزین تابع قبلی کن :

Public Function PrintFiles(FolderPath, fileName As String)
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
End Function

بعد در رویداد کلیک باتن چاپ تابع رو بصورت زیر فراخوانی کن :

Call PrintFiles("E:\folder1", "1.pdf")

بجای آرگومان اول مسیر فولدر و بجای آرگومان دوم نام فایل مورد نظر رو جایگزین کن

محمد رضا بهبودی

شنبه 11 اسفند 1403, 07:24 صبح

با سلام و احترام
استاد گرامی
از لطف و عنایت جنابعالی بسیار سپاسگزارم
ولی در زمان اجرا این خطا نمایش داده می شود156442

eb_1345

شنبه 11 اسفند 1403, 09:18 صبح

خُب این خطا داره بهت میگه که سابروتین یا فانکشن 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

محمد رضا بهبودی

شنبه 11 اسفند 1403, 10:39 صبح

خُب این خطا داره بهت میگه که سابروتین یا فانکشن 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

با سلام و احترام
ممنون استاد گرامی
کاملا موضوع حل شد