''''''''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
