''''''''MODULE1 Option Explicit '''''''''''''In input box assign the path i.e c:\tc\bin '''''''''''''for more help u can contact directly at rfhyd1...@gmail.com Sub Batch_Print() Dim Input_Dir, Print_File As String Input_Dir = InputBox _ ("Input directory path containing the files to print") Print_File = Dir(Input_Dir & "\*.xl*") Do While Len(Print_File) > 0 Workbooks.Open Filename:=Input_Dir & "\" & Print_File ActiveWorkbook.PrintOut Copies:=1 ActiveWorkbook.Close Print_File = Dir() Loop End Sub
'''''''''''''''''''''MODULE2 Option Explicit Public Const KEY_ENUMERATE_SUB_KEYS = &H8 Public Const HKEY_LOCAL_MACHINE = &H80000002 Public Const SUCCESS = 0& Type FILETIME dwLowDateTime As Long dwHighDateTime As Long End Type Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _ "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As _ String, ByVal ulOptions As Long, ByVal samDesired As _ Long, phkResult As Long) As Long Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias _ "RegEnumKeyExA" (ByVal hKey As Long, ByVal dwIndex As _ Long, ByVal lpName As String, lpcbName As Long, ByVal _ lpReserved As Long, ByVal lpClass As String, lpcbClass _ As Long, lpftLastWriteTime As FILETIME) As Long Declare Function RegCloseKey Lib "advapi32.dll" _ (ByVal hKey As Long) As Long Public Sub GetInstalledPrinters(ByRef sPrinters() As _ String, ByRef cPrinters As Long) ' Sets cPrinters to the number of installed printers. ' Sizes and fills sPrinters array with the names ' of these printers. Dim ft As FILETIME Dim KeyHandle As Long Dim KeyName As String Dim KeyLen As Long Dim Response As Long On Error GoTo ERR_INSTALLED_PRINTERS ReDim sPrinters(1 To 5) cPrinters = 0 ' Open registry key whose subkeys are installed printers Response = RegOpenKeyEx(HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\Print\Printers", 0, KEY_ENUMERATE_SUB_KEYS, KeyHandle) ' If Error display message and exit If Response <> SUCCESS Then MsgBox "Could not open the registry key." Exit Sub End If ' Loop to get subkeys Do KeyLen = 1000 ' Plenty of room for printer name KeyName = String(KeyLen, 0) ' Fill with 0s Response = RegEnumKeyEx(KeyHandle, cPrinters, _ KeyName, KeyLen, 0&, vbNullString, 0&, ft) ' If unsuccessful, then exit If Response <> SUCCESS Then Exit Do ' Next free index cPrinters = cPrinters + 1 ' Make room if necessary If UBound(sPrinters) < cPrinters Then ReDim Preserve sPrinters(1 To cPrinters + 5) End If ' Add to array sPrinters(cPrinters) = Left(KeyName, KeyLen) Loop RegCloseKey KeyHandle Exit Sub ERR_INSTALLED_PRINTERS: MsgBox Err.Description Exit Sub End Sub Sub DisplayInstalledPrinters() Dim sPrinters() As String Dim cPrinters As Long Dim i As Integer Dim msg As String ' Get the installed printers GetInstalledPrinters sPrinters(), cPrinters ' Create the message and display it msg = "" For i = 1 To cPrinters msg = msg & sPrinters(i) & vbCrLf Next i MsgBox msg, , cPrinters & " Printers" End Sub On Tue, Dec 15, 2009 at 3:00 AM, Vinod N <nvino...@gmail.com> wrote: > Hi Excel Gurus, > > Many image files(tif)(say 200 files) will be pasted in a particular folder > through fax server and i need to take printout of the same and also keep a > log/list of image that has been printed. > > Can a code be created such that i can click a button and the files from > that printer are printed and the names and fax time of the image are added > in an excel file > > If required, we can saved the excel file in the designated folder and then > we can run the macro > > > Please feel free to contact me in case i'm too vague in my criteria or > any additional data is required > -- > Thanks and Regards > > Vinod N > > -- > > ---------------------------------------------------------------------------------- > Some important links for excel users: > 1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at > http://www.excelitems.com > 2. Excel tutorials at http://www.excel-macros.blogspot.com > 3. Learn VBA Macros at http://www.vbamacros.blogspot.com > 4. Excel Tips and Tricks at http://exceldailytip.blogspot.com > > > To post to this group, send email to excel-macros@googlegroups.com > If you find any spam message in the group, please send an email to: > Ayush Jain @ jainayus...@gmail.com or > Ashish Jain @ 26may.1...@gmail.com > <><><><><><><><><><><><><><><><><><><><><><> > HELP US GROW !! > > We reach over 6,500 subscribers worldwide and receive many nice notes about > the learning and support from the group. Our goal is to have 10,000 > subscribers by the end of 2009. Let friends and co-workers know they can > subscribe to group at > http://groups.google.com/group/excel-macros/subscribe -- ---------------------------------------------------------------------------------- Some important links for excel users: 1. Excel and VBA Tutorials(Video and Text), Free add-ins downloads at http://www.excelitems.com 2. Excel tutorials at http://www.excel-macros.blogspot.com 3. Learn VBA Macros at http://www.vbamacros.blogspot.com 4. Excel Tips and Tricks at http://exceldailytip.blogspot.com To post to this group, send email to excel-macros@googlegroups.com If you find any spam message in the group, please send an email to: Ayush Jain @ jainayus...@gmail.com or Ashish Jain @ 26may.1...@gmail.com <><><><><><><><><><><><><><><><><><><><><><> HELP US GROW !! We reach over 6,500 subscribers worldwide and receive many nice notes about the learning and support from the group. Our goal is to have 10,000 subscribers by the end of 2009. Let friends and co-workers know they can subscribe to group at http://groups.google.com/group/excel-macros/subscribe