Can you save a report

[Bob]

Its creating C:\Statements if there is not a folder but still getting that
error as stated................Thanks Bob

 

[Bob]

Jacob can you test my code on your machine Thanks, Bob

Private Sub cmdStatement_Click()
'bob's Statements

Dim saveReport As Integer, savFileName As String

Select Case Me.OpenArgs

Case "OwnerStatement"

If IsNull(cbOwnerName.value) = True Or _
cbOwnerName.value = vbNullString Then
MsgBox "Please Select the Owner.", _
vbApplicationModal + vbInformation _
+ vbOKOnly 'added + ( to vbokonlt)
Exit Sub
End If
'**************************************
savFileName = bAutoRenameFile("rptOwnerPaymentMethod.snp") '

'will return "rptOwnerPaymentMethos1.snp",
'"rptOwnerPaymentMethos2.snp"
' etc
savFileName = "C:\Statements\" & savFileName
'savFileName = "C:\Statements\" & "rptOwnerPaymentMethod" _
& ".SNP"
' ***********************************************
DoCmd.OutputTo acOutputReport, "rptOwnerPaymentMethod", _
"Snapshot Format", savFileName, True
' ......... etc

'DoCmd.OpenReport "rptOwnerPaymentMethod", ******

'acViewPreview ********Relaced
'**************************
'DoCmd.Close acForm, Me.Name

Case "MonthlyPaid"

'******************
'Me.Visible = False ******** Not needed
savFileName = "C:\Statements\" & "rptGenericReport" _
& ".SNP"
' Me.Visible = False ****now You dont need this *****
DoCmd.OutputTo acOutputReport, "rptGenericReport", _
"Snapshot Format", savFileName, True
'DoCmd.OpenReport "rptGenericReport", _******* Replaced
'acViewPreview, , , , "MonthlyPaid" ******* Repalce
'**************************************************
'Report_rptGenericReport.tbTotal.value = _
'SUM (Report_rptGenericReport.tbAmount)
'DoCmd.Close acForm, Me.Name

Case "OwnerDue"

Me.Visible = False
DoCmd.OpenReport "rptGenericReport", acViewPreview, , , ,
"OwnerDue"
DoCmd.Close acForm, Me.Name
Case "OwnerPaymentMethod"

If IsNull(cbOwnerName.value) = True Or cbOwnerName.value =
vbNullString Then
MsgBox "Please Select the Owner.", vbApplicationModal +
vbInformation + vbOKOnly
Exit Sub
End If

Me.Visible = False
DoCmd.OpenReport "rptGenericReport", acViewPreview, , , ,
"OwnerPaymentMethod"
DoCmd.Close acForm, Me.Name

Case "PaymentMethod"

Dim nDateDiff As Integer, nSign As Integer
nDateDiff = DateDiff("d", CDate(tbDateFrom.value),
CDate(tbDateTo.value))
nSign = Sgn(nDateDiff)

If nSign = -1 Or nSign = 0 Then
MsgBox "Please Select Date In Proper Range.",
vbApplicationModal + vbExclamation + vbOKOnly
cmdCalenderTo.SetFocus
Exit Sub
End If

Me.Visible = False
DoCmd.OpenReport "rptGenericReport", acViewPreview, , , ,
"PaymentMethod"
DoCmd.Close acForm, Me.Name
Case "PrintInvoiceBatch"
If IsNull(tbDateFrom.value) Or tbDateFrom.value = "" Or
IsNull(tbDateTo.value) Or tbDateTo.value = "" Then
MsgBox "Please Enter the Begining Date and End Date.",
vbApplicationModal + vbInformation + vbOKOnly
Exit Sub
End If
Me.Visible = False
DoCmd.OpenReport "rptInvoiceBatch", acViewPreview, , , ,
"PrintInvoiceBatch"
'DoCmd.Close acForm, Me.Name
Case "PrintStatementBatch"
If IsNull(tbDateFrom.value) Or tbDateFrom.value = "" Or
IsNull(tbDateTo.value) Or tbDateTo.value = "" Then
MsgBox "Please Enter the Begining Date and End Date.",
vbApplicationModal + vbInformation + vbOKOnly
Exit Sub
End If
Me.Visible = False
DoCmd.OpenReport "rptOwnerPaymentMethodBatch", acViewPreview, , , ,
"PrintStatementBatch"
'DoCmd.Close acForm, Me.Name
End Select
'DoCmd.OpenReport "rptInvoiceBatch", acViewPreview, , , ,
"PrintInvoiceBatch"
End Sub

 

[Bob]

Jacob, Another thing when I put my cursor on the yellowed out part, I am
getting this cursor label
savFileName=C:\Statements\C:\Statements\rptOwnerPaymentMethod1.snp
Should Statements appear twice and is the 1 after report ok?
When I undo comment out :
savFileName = "C:\Statements\" & "rptOwnerPaymentMethod" _
& ".SNP"
This is working fine but only keeps the last report
Thanks Bob

 

[JK]

Bob,

Oops, my fault :-(
Sooooorrrrryyyy

The bAutoRenameFile() already places the directory name in the begining of
"savFileName".

Remove:

"savFileName = "C:\Statements\" & savFileName"
because this make the file name illegal, i.e as it adds the directory name
again and gives you:

"C:\Statements\C:\Statements\rptOwnerPaymentMethos1.snp"
which is an ilegal file name.

This shoud solve the problem:

savFileName = bAutoRenameFile("rptOwnerPaymentMethod.snp") '

' ** will return "C:\Statements\rptOwnerPaymentMethos1.snp",
' "C:\Statements\rptOwnerPaymentMethos2.snp" etc

' *** Remove ***savFileName = "C:\Statements\" & savFileName
*****
'savFileName = "C:\Statements\" & "rptOwnerPaymentMethod" _
& ".SNP"

DoCmd.OutputTo acOutputReport, "rptOwnerPaymentMethod", _
"Snapshot Format", savFileName, True


Let me know how you go.

Regards/JK

 

[Bob]

Brilliant Jacob
2 things What happens if I get a new Machine and it does not have a C Drive?
And can snap open in Maximize
Thanks for your help.......Bob

 

[JK]

Bob,


1.

Every PC has a drive C:, however, I modified the function to allow you to
specify drive and Directory, the function default to C:\ statements thus you
don't have to change anything in your program, just replace the function
with the one down below.

If you want to save in another folder, supply the drive and folder when you
call the function eg, if you want to save in "C:\Accounts

yourSaveName=bAutoRenameFile("YourFileName","D:\Accounts")

Alternatively if you want to change the default of the *function* edit the
function and in the declaration of the function and change:

"Optional strPath as string="C:\Statements"
to
"Optional strPath as string="C:\Accounts"

Please note that if you specify the path as "C:\Accounts\Statements" and you
don't have "C:\Accounts" folder you will get en error.


2.

I don't think that you can open the snapshot viewer in a maximize view, or
at least I can't find how.

Regards
Jacob


Here is the modified function:

Private Function bAutoRenameFile( _
strTestName As String, _
Optional strPath As String = "C:\Statements") _
As String

'For Bob
'output: returns unique .snp file in C:\Staements
'by adding a number at end of the file name
'eg "Test1.snp", "test2.snp" etc when (strTestName="Test"
'where (strTestName="Test"or test.snp
'Return the original string on unresoved errors
'if C:\Statements does not exist it will create it
'after prompting

On Error GoTo ErrorHandler

Dim fs As Object, _
strFile As String, _
strDir As String, _
strSfx As String, _
numSfx As Long, _
nPos As Long, _
tmpStr As String

'fs: FilseSearch object
'strFile: File name withot extension (if any)
'strDir: path to file
'strSfx: File extenstion
'numSfx: suffix number to add/replace to file name
'nPos: position in string
'tmpStr: temporary stroarge

'Msg\InputBox parameters:
Dim msgPmt As String, _
msgBtns As Integer, _
msgTitle As String, _
msgResp As Integer, _
inpPmt As String

'initialising
'strDefDir = Application.CurrentProject.Path
bAutoRenameFile = ""
tmpStr = Trim(strTestName)
msgTitle = "bAutoRenameFile Function"

'---- test for empty file name
msgBtns = vbExclamation
inpPmt = "Empty file name is not allowd!" & Chr(13) _
& "Please enter a valid file name: "

If Len(tmpStr) = 0 Then
GoTo GetFileName
Else
GoTo TestFileName
End If

GetFileName:
tmpStr = InputBox(inpPmt, msgTitle, tmpStr)

If Len(tmpStr) = 0 Then
msgBtns = vbYesNo + vbExclamation
msgPmt = "No file Name Entered " & Chr(13) _
& "Re-enter file name? "
msgResp = MsgBox(msgPmt, msgBtns, msgTitle)
If msgResp = vbYes Then
GoTo GetFileName
Else
bAutoRenameFile = strTestName
Exit Function
End If
End If


TestFileName:
nPos = InStrRev(tmpStr, ".")
If nPos = 0 Then 'no extension entered
strFile = tmpStr
strSfx = ".snp"
Else
strFile = Left(tmpStr, nPos - 1)
strSfx = Right(tmpStr, Len(tmpStr) - nPos + 1)
End If
'strDir = "C:\Statements"
strDir = IIf(IsMissing(strPath) Or Len(strPath) = 0, _
"C:\Statements", strPath)


'---- Test directory exists
If Len(Dir(strDir, vbDirectory)) = 0 Then
msgBtns = vbOKCancel + vbQuestion
msgPmt = "Directory '" & strDir & "' dose bot exist! " _
& Chr(13) & "Create Direcory?"
msgResp = MsgBox(msgPmt, msgBtns, Left(msgTitle, 23))
If msgResp = vbCancel Then
bAutoRenameFile = strTestName
Exit Function
End If
MkDir strDir
GoTo EndExit
End If

'-----Look For exiting files
numSfx = 0
Set fs = Application.FileSearch

LookForDup:
'strFile = strFile & IIf(numSfx = 0, "", numSfx)
tmpStr = strFile & IIf(numSfx = 0, "", numSfx)

With fs
.lookin = strDir
.FileName = tmpStr & strSfx
If .Execute > 0 Then 'File found
numSfx = numSfx + 1
GoTo LookForDup
End If


End With
EndExit:
bAutoRenameFile = strDir & "\" & tmpStr & strSfx
Exit Function

ErrorHandler:
msgBtns = vbExclamation
MsgBox "Error Number: " & Err.Number & Chr(13) _
& "Descrtpion: " & Err.Description

bAutoRenameFile = strTestName
Exit Function


End Function

 

[Bob]

Thanks Jacob Brilliant
Did you notice there is a Batch Print option this could not save them into
C:\Statements as well
thanks for the help..............Regards Bob
Case "PrintInvoiceBatch"
If IsNull(tbDateFrom.value) Or tbDateFrom.value = "" Or
IsNull(tbDateTo.value) Or tbDateTo.value = "" Then
MsgBox "Please Enter the Begining Date and End Date.",
vbApplicationModal + vbInformation + vbOKOnly
Exit Sub
End If
Me.Visible = False
DoCmd.OpenReport "rptInvoiceBatch", acViewPreview, , , ,
"PrintInvoiceBatch"

Case "PrintStatementBatch"
If IsNull(tbDateFrom.value) Or tbDateFrom.value = "" Or
IsNull(tbDateTo.value) Or tbDateTo.value = "" Then
MsgBox "Please Enter the Begining Date and End Date.",
vbApplicationModal + vbInformation + vbOKOnly
Exit Sub
End If
Me.Visible = False
DoCmd.OpenReport "rptOwnerPaymentMethodBatch", acViewPreview, , , ,
"PrintStatementBatch"

End Select

 

[JK]

Bob

I tested the function on my data, (I don't have your reports).
What is different about the print batch from other printouts

If you wish, zip your database and mail it to me to:.
<sarichart at ozzienet dot net>
(put in subject "From Bob" or something that allows me to distinguish it
from a spam.

Regards
Jacob