Printing bulk of letters all together instead of printing one after another

Hi guys

I designed an application in excel as a frontend and Access backend. Now in the userform when the user types all the details in it and press "Complete" button then a letter with all those details gets printed out.

Now the problems users getting are:

1. As they have to type sometimes about 100 letters so each time they press "Complete" the letter gets printed out they have to go to printer to collect the letter otherwise it can get mixed with other documents other users are doing or may be lost.So if one user is doing 100 letters then 100 times he will go to printer and collect it.

Is there any solution so that those letters get saved somewhere and when they press print then the bulk of letters should be printed off together so that they can go just once to printer to collect all the letters.

Presently I have written the following code on "Complete" button:

dim ws as worksheet
set ws=thisworkbook.worksheets("sheet1")
ws.printout

Thanks

Try to use this code. Do your command call Sub cmd_complete.
This macro will copy all your sheet in a new workbook called 'myLetters.xls' auto saved in your 'my document' folder.
when you close your workbook you will see workbook 'myLetters.xls' with the copy of all your letters.

See attached file, I hope it's what you need.

Regards,
Antonio

Private Declare Function SHGetSpecialFolderPath Lib "shell32.dll" _
      Alias "SHGetSpecialFolderPathA" (ByVal hwnd As Long, _
      ByVal pszPath As String, ByVal csidl As Long, _
      ByVal fCreate As Long) As Long
Private Const MAX_PATH = 260

Const myWbName As String = "myLetters.xls"

Option Explicit
Sub cmd_complete()
   Dim myDocPath As String, myFileName As String
   Dim myWb As Workbook
   
   On Error Resume Next
   Set myWb = Workbooks(myWbName)
   On Error GoTo 0
   
   Application.ScreenUpdating = False
   Application.EnableEvents = False
   If myWb Is Nothing Then
      'wb not opened
      myDocPath = GetSpecialFolderPath("5") & "\"
      myFileName = myDocPath & myWbName
      If Dir(myFileName) <> "" Then
         'wb exists, then open it
         Set myWb = Workbooks.Open(myFileName)
      Else
         'wb doesn't exist, it will be created and saved
         Set myWb = Workbooks.Add
         'delete all sheets
         Application.DisplayAlerts = False
         Do While myWb.Sheets.Count > 1
            myWb.Sheets(2).Delete
         Loop
         Application.DisplayAlerts = True
         myWb.Sheets(1).Name = "noprint"
         myWb.SaveAs Filename:=myFileName, FileFormat:=xlNormal, _
               Password:="", WriteResPassword:="", _
               ReadOnlyRecommended:=False, CreateBackup:=False
      End If
   End If
   
   'copy sheet to myLetters.xls
   ThisWorkbook.ActiveSheet.Copy after:=myWb.Sheets(myWb.Sheets.Count)
   ThisWorkbook.Activate
   myWb.Save
   
   Application.EnableEvents = True
   Application.ScreenUpdating = True
End Sub
Private Function GetSpecialFolderPath(ByVal fldNo As Long) As String
   Dim Path As String, hwnd
   Path = Space$(MAX_PATH)
   If SHGetSpecialFolderPath(hwnd, Path, fldNo, False) Then
      GetSpecialFolderPath = Left$(Path, InStr(Path, Chr(0)) - 1)
   Else
      GetSpecialFolderPath = ""
   End If
End Function