'*******************This goes in a normal module*******************
Option Explicit
Sub tstExport()
Dim oE As ClaExporter2
Dim strDesc As String
Dim intMsg As Integer
Dim intReply As Integer
Dim intReply2 As Integer
Dim strReport As String
Set oE = New ClaExporter2
With oE
Do Until intReply = vbYes
intReply = 0
intMsg = 0
strDesc = vbNullString
On Error Resume Next
.Template = BrowseFile("Select the job template file.", ThisWorkbook.Path)
.OutputDir = BrowseFolder("Select the directory where the job folder should go.", ThisWorkbook.Path)
If GblnErr Then On Error GoTo err Else On err GoTo 0
If .Template = vbNullString Or .OutputDir = vbNullString Then
If .Template = vbNullString Then strDesc = "Please select the job template file."
If .OutputDir = vbNullString Then
If strDesc = vbNullString Then
strDesc = "Please select the directory where the job folder should go."
Else
strDesc = Left(strDesc, Len(strDesc) - 1) & " and the directory where the job folder should go."
End If
End If
strDesc = strDesc & vbCrLf & vbCrLf & "Both a template and output directory are required."
End If
If strDesc = vbNullString Then intReply = MyMsgBox( _
Prompt:="Export processe cannot be stopped once begun." & vbCrLf & _
"Please verify your selections." & vbCrLf & vbCrLf & " Selected template: " & vbCrLf & _
" " & .Template & vbCrLf & " Selected output directory: " & vbCrLf & " " & .OutputDir _
& vbCrLf & vbCrLf & "Are these selections correct for this job?", _
Buttons:=vbExclamation + vbYesNo, _
Title:="Verify selections")
If intReply = vbNo Then strDesc = "Selections not verified."
If strDesc <> vbNullString Then intReply2 = MyMsgBox( _
Prompt:=strDesc & vbCrLf & "Would you like to retry selections?", _
Buttons:=vbQuestion + vbRetryCancel, _
Title:="Not ready to export")
If intReply2 = vbCancel Then
MyMsgBox _
Prompt:="User cancelled." & vbCrLf & "No file or folder changes were made.", _
Buttons:=vbCritical + vbOKOnly, _
Title:="Export cancelled"
Set oE = Nothing
Exit Sub
End If
Loop
With oE
.EntireWorkbook
End With
End With
Set oE = Nothing
Exit Sub
err:
MyMsgBox err.Number
End Sub
'*******************This goes in class module ClaExporter2*******************
Option Explicit
Private blnScreen As Boolean
Private blnEvents As Boolean
Private strW As String
Private strO As String
Private strER As String
Public Property Get Template() As String
Template = strW
End Property
Public Property Let Template(value As String)
If Not value = "False" Then strW = value
End Property
Public Property Get OutputDir() As String
OutputDir = strO
End Property
Public Property Let OutputDir(value As String)
strO = value
End Property
Private Property Get TemplateName() As String
With Me
TemplateName = Mid(.Template, InStrRev(.Template, "\") + 1)
End With
End Property
Private Property Get TemplateDir() As String
With Me
TemplateDir = Left(.Template, Len(.Template) - Len(TemplateName) + 1)
End With
End Property
Private Property Get JobNo() As String
With ThisWorkbook.Sheets("DATA ENTRY")
JobNo = .Cells.Find(what:="JOB", After:=.Cells(1, 1), LookIn:=xlFormulas, _
lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious, MatchCase:=False).Offset(0, -1)
End With
End Property
Sub EntireWorkbook()
Dim wkbk As Workbook
Dim ws As Worksheet
Dim wsWhere As Worksheet
Dim intX As Integer
Dim intX2 As Integer
Dim strFileName As String
Dim strDone As String
Dim strOutDir As String
Dim strSaveDir As String
Dim strNoCreFiles As String
Dim strCreFiles As String
Dim strNoCreDirs As String
Dim strCreDirs As String
Dim strSubReport As String
Dim rngAddress As Range
Dim oPro As ClaProtector
Set oPro = New ClaProtector
With Application
.Calculation = xlManual
blnScreen = .ScreenUpdating
blnEvents = .EnableEvents
.ScreenUpdating = False
.EnableEvents = False
End With
If oBar Is Nothing Then
Set oBar = New ClaProgressBar
oBar.Show "Exporting Forms..."
End If
oBar.Update "Exporting Forms..."
strOutDir = Me.OutputDir & "\" & JobNo
On Error Resume Next
err.Clear
MkDir strOutDir
If err.Number = 75 Then
strNoCreDirs = strNoCreDirs & vbCrLf & " " & strOutDir
Else
strCreDirs = strCreDirs & vbCrLf & " " & strOutDir
End If
If GblnErr Then On Error GoTo err Else On Error GoTo 0
For Each ws In ThisWorkbook.Worksheets
With ws
Select Case ws.Name
Case "HELP", "QUERY DATA", "TABULAR DATA", "INPUT", "DATA ENTRY"
Case Else
intX = intX + 1
End Select
End With
Next
For Each ws In ThisWorkbook.Worksheets
With ws
Select Case .Name
Case "HELP", "QUERY DATA", "TABULAR DATA", "INPUT", "DATA ENTRY"
Case Else
intX2 = intX2 + 1
oBar.Update "Exporting: " & .Name & vbCrLf & vbCrLf & "Completed: " & strDone
strFileName = JobNo & "_" & .Name
Set rngAddress = TrueUsedRange(ws)
Set wkbk = Nothing
Do Until Not wkbk Is Nothing
On Error Resume Next
Set wkbk = Workbooks(TemplateName)
If GblnErr Then On Error GoTo err Else On Error GoTo 0
If wkbk Is Nothing Then Application.Workbooks.Open Me.Template
Loop
Set wsWhere = wkbk.Sheets("Sheet1")
With wsWhere
With oPro
.TheSheet = wsWhere
.Remove
End With
On Error Resume Next
TrueUsedRange(wsWhere).Clear
rngAddress.Copy
If GblnErr Then On Error GoTo err Else On Error GoTo 0
With .Range(rngAddress.Address)
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
.PasteSpecial xlPasteColumnWidths
End With
oPro.Protect
strSaveDir = strOutDir & "\" & strFileName
On Error Resume Next
err.Clear
MkDir strSaveDir
If err.Number = 75 Then
strNoCreDirs = strNoCreDirs & vbCrLf & " " & strSaveDir
Else
strCreDirs = strCreDirs & vbCrLf & " " & strSaveDir
End If
If GblnErr Then On Error GoTo err Else On Error GoTo 0
On Error Resume Next
err.Clear
With .Parent
.SaveAs Filename:=strSaveDir & "\" & strFileName, WriteResPassword:="mypassword", ReadOnlyRecommended:=True
.Close savechanges:=False
If err.Number = 1004 And Right(err.Description, Len("write reserved.")) = "write reserved." Then
strNoCreFiles = strNoCreFiles & vbCrLf & " " & strFileName
Else
strCreFiles = strCreFiles & vbCrLf & " " & strFileName
End If
End With
If GblnErr Then On Error GoTo err Else On Error GoTo 0
End With
strDone = strDone & vbCrLf & .Name
oBar.Update Done:=(intX2 / intX) * 100
End Select
End With
Next
On Error Resume Next
Workbooks(TemplateName).Close savechanges:=False
err.Clear
If GblnErr Then On Error GoTo err Else On Error GoTo 0
Set oPro = Nothing
oBar.Done
If strCreDirs = vbNullString Then strCreDirs = " none"
If strNoCreDirs = vbNullString Then strNoCreDirs = " none"
If strCreFiles = vbNullString Then strCreFiles = " none"
If strNoCreFiles = vbNullString Then strNoCreFiles = " none"
strSubReport = "Created Directories: " & strCreDirs & vbCrLf & vbCrLf & _
"Found Existing Directories: " & strNoCreDirs & vbCrLf & vbCrLf & _
"Created Files: " & strCreFiles
If Trim(strNoCreFiles) = "none" Then
strReport = "All sheets were exported successfully." & vbCrLf & vbCrLf & strSubReport
Else
strReport = "Not all sheets were exported." & vbCrLf & vbCrLf & strSubReport & vbCrLf & vbCrLf & _
"-----------------------------------" & vbCrLf & vbCrLf & _
"The following were not exported because a file with the same name already exists:" & strNoCreFiles
End If
Application.ScreenUpdating = blnScreen
Application.EnableEvents = blnEvents
Application.Calculation = xlAutomatic
MyMsgBox _
Prompt:=strReport, _
Buttons:=vbOKOnly, _
Title:="Export report"
'***********EVERYTHING WOULD PLAY UP TO HERE***********
Exit Sub '***********APPLICATION WOULD CRASH HERE************
err:
Dim oErr As ClaErrors
Set oErr = New ClaErrors
With oErr
.errModule = "ClaExport"
.errProcedure = "EntireWorkbook"
.Error
End With
Set oErr = Nothing
End Sub
But I just created a new property for my class, set it to the string I was displaying in the message box, then display the message box from my calling procedure instead, and everything works. Go figure. 
. Thanks!
