It says error on Line 32....
The given code is of visual basic. I guess I have got everything correct but have no clue what I did wrong. when I checked about it in the console it said line 32
Module Module1
Sub Main()
Dim isInKG As Boolean = Nothing
Dim canDrink As Boolean = Nothing
Dim isSeniorCitizen As Boolean = Nothing
Console.WriteLine("what is your age?")
Dim age As Integer = Console.ReadLine()
Dim outcomeKG As String = Nothing
Dim outcomeSenior As String = Nothing
Dim outcomeDrink As String = Nothing
If age <> 5 Then
isInKG = False
outcomeKG = "You arent in KG"
Else
isInKG = True
outcomeKG = "You are in KG"
End If
If age >= 65 Then
isSeniorCitizen = True
outcomeSenior = "You are a Senior Citizen"
Else
isSeniorCitizen = False
outcomeSenior = "You are a Junior Citizen"
End If
If age >= 21 Then
canDrink = True
outcomeDrink = "Go and get drunk"
Else
canDrink = False
outcomeDrink = "Sorry Kiddo Not until 21 "
End If
Console.WriteLine(outcomeDrink & " " & outcomeKG & " " & outcomeSenior " " &)
Console.ReadLine()
End Sub
End Module
Third row from the bottom has wrong order...
try this
Console.WriteLine(outcomeDrink & " " & outcomeKG & " " & outcomeSenior & " ")
Related
Here is my problem:
Duplicate versions
I checked the version history on the Sharepoint site and it doesn't show any duplicates.
Here is the code im using:
Sub versionhistory()
'
' versionhistory Macro
On Error Resume Next
' On Error GoTo message
Dim dlvVersions As Office.DocumentLibraryVersions
Dim dlvVersion As Office.DocumentLibraryVersion
Dim strVersionInfo As String
Set dlvVersions = ThisDocument.DocumentLibraryVersions
'MsgBox ActiveDocument.Bookmarks.Count
Dim tbl As Word.Table
'Set tbl = ActiveDocument.Tables.Item(2)
Set tbl = ActiveDocument.Bookmarks("VersionTable").Range.Tables(1)
If dlvVersions.IsVersioningEnabled Then
strVersionInfo = "This document has " & dlvVersions.Count & " versions: " & vbCrLf
Call InsertVersionHistory(tbl, dlvVersions)
For Each dlvVersion In dlvVersions
strVersionInfo = strVersionInfo & _
" - Version #: " & dlvVersion.Index & vbCrLf & _
" - Modified by: " & dlvVersion.ModifiedBy & vbCrLf & _
" - Modified on: " & dlvVersion.Modified & vbCrLf & _
" - Comments: " & dlvVersion.Comments & vbCrLf
Next
Else
strVersionInfo = "Versioning not enabled for this document."
End If
'MsgBox strVersionInfo, vbInformation + vbOKOnly, "Version Information"
Set dlvVersion = Nothing
Set dlvVersions = Nothing
Call GetUserName
'message:
'MsgBox Err.Description
MsgBox ("Insert Version Number in the Header and type a Title in the [Insert Title here] on the front page. It will be automatically updated in the footer." & vbNewLine & vbNewLine & "Do Not Type in the Review and Version tables.")
End Sub
Private Function InsertVersionHistory(oVerTbl As Word.Table, oVersions As Office.DocumentLibraryVersions)
Dim rowIndex As Integer
Dim oVersion As Office.DocumentLibraryVersion
Dim oNewRow As Row
'test
Dim versionIndex As Integer
For rowIndex = 2 To oVerTbl.Rows.Count
oVerTbl.Rows.Item(2).Delete
Next rowIndex
rowIndex = 1
'test
versionIndex = oVersions.Count
For Each oVersion In oVersions
If (rowIndex > 5) Then
Return
End If
rowIndex = rowIndex + 1
oVerTbl.Rows.Add
Set oNewRow = oVerTbl.Rows(oVerTbl.Rows.Count)
oNewRow.Shading.BackgroundPatternColor = wdColorWhite
oNewRow.Range.Font.TextColor = wdBlack
oNewRow.Range.Font.Name = "Tahoma"
oNewRow.Range.Font.Bold = False
oNewRow.Range.Font.Size = 12
oNewRow.Range.ParagraphFormat.SpaceAfter = 4
With oNewRow.Cells(1)
'.Range.Text = oVersion.Index
.Range.Text = versionIndex
End With
With oNewRow.Cells(2)
.Range.Text = FormUserFullName(GetUserFullName(oVersion.ModifiedBy))
End With
With oNewRow.Cells(3)
.Range.Text = oVersion.Modified
End With
With oNewRow.Cells(4)
.Range.Text = oVersion.Comments
End With
versionIndex = versionIndex - 1
Next
Set oVersion = Nothing
End Function
Function GetUserFullName(userName As String) As String
Dim WSHnet, UserDomain, objUser
Set WSHnet = CreateObject("WScript.Network")
'UserDomain = WSHnet.UserDomain
'Set objUser = GetObject("WinNT://" & UserDomain & "/" & userName & ",user")
userName = Replace(userName, "\", "/")
Set objUser = GetObject("WinNT://" & userName & ",user")
'MsgBox objUser.FullName
GetUserFullName = objUser.FullName
End Function
Function FormUserFullName(userName As String) As String
Dim arrUserName As Variant
Dim changedUserName As String
arrUserName = Split(userName, ",")
Dim length As Integer
length = UBound(arrUserName) - LBound(arrUserName) + 1
If length >= 2 Then
changedUserName = arrUserName(1) & " " & arrUserName(0)
Else
changedUserName = userName
End If
FormUserFullName = changedUserName
End Function
Private Function GetUserName()
Dim userName As String
userName = ActiveDocument.BuiltInDocumentProperties("Author")
ActiveDocument.BuiltInDocumentProperties("Author") = FormUserFullName(userName)
End Function
I know this is old, but I was looking for the same thing and found this article. I'm still trying it out, but wanted to share before I got distracted with my real job.
From: SixSigmaGuy on microsoft.public.sharepoint.development-and-programming.narkive.com/...
Wanted to share my findings, so far. Surprisingly, I could not find
anything in the SharePoint Designer object/class that supported versions,
but the Office, Word, Excel, and PowerPoint objects do support it.. It
wasn't easy to find, but once I found it, it works great, as long as the
file in the document library is one of the Office documents.
Here's some sample code, written in Excel VBA, showing how to get the
version information for a paritcular SharePoint Document Library file
created in Excel:
Public viRow As Long
Function fCheckVersions(stFilename As String) As Boolean
' stFilename is the full URL to a document in a Document Library.
'
Dim wb As Excel.Workbook
Dim dlvVersions As Office.DocumentLibraryVersions
Dim dlvVersion As Office.DocumentLibraryVersion
Dim stExtension As String
Dim iPosExt As Long
ThisWorkbook.Worksheets("Sheet1").Cells(viRow, 1) = stFilename
If Workbooks.CanCheckOut(stFilename) = True Then
Set wb = Workbooks.Open(stFilename, , True)
Set dlvVersions = wb.DocumentLibraryVersions
If dlvVersions.IsVersioningEnabled = True Then
ThisWorkbook.Worksheets("Sheet1").Cells(viRow, 3) = "Num
Versions = " & dlvVersions.Count
For Each dlvVersion In dlvVersions
ThisWorkbook.Worksheets("Sheet1").Cells(viRow, 4) = "Version: " & dlvVersion.Index
ThisWorkbook.Worksheets("Sheet1").Cells(viRow, 5) = "Modified Date: " & dlvVersion.Modified
ThisWorkbook.Worksheets("Sheet1").Cells(viRow, 6) = "Modified by: " & dlvVersion.ModifiedBy
ThisWorkbook.Worksheets("Sheet1").Cells(viRow, 7) = "Comments: " & dlvVersion.Comments
viRow = viRow + 1
Next dlvVersion
End If
wb.Close False
End If
Set wb = Nothing
DoEvents
End Function`
Fortunately, I discovered that Excel can open non-Excel files in most
cases. I.e., I can, for example, open a jpg file in Excel and use the
dlvVersions collection for that file.
I am making my first project using vb.net and access. I am trying to develop a project in which the data of patients of the is added from different counters.it works fine till 22nd or 23rd record entered. after that adding new record over writes the last saved record.
to check the database i deleted some record (say after deletion there are 13 records left in the database) and tried to add new record, it gives the same problem, the 13th record is overwritten by the new record.
i deleted all the records and tried to add new record, the first record successfully entered but after that new record entry over writes the last (only) record.
i'm unable to understand the problem
code for saving data is
Private Sub Save()
'Dim st As String
Dim str As String
btnSave_Click = False
str = check
If Not str = "" Then
MsgBox(str, vbInformation, "Patient Registration")
btnSave_Click = False
Exit Sub
End If
If conn.State = 0 Then
Module1.openConnection()
End If
If Not rsDept Is Nothing Then
If rsDept.State = 0 Then
Call openRecordset("SELECT * FROM tblDept", rsDept)
End If
Else
Call openRecordset("SELECT * FROM tblDept", rsDept)
End If
If Not rsData Is Nothing Then
If rsData.State = 0 Then
Call openRecordset("Select * from tblPatientRecord", rsData)
End If
Else
Call openRecordset("Select * from tblPatientRecord", rsData)
End If
conn.BeginTrans()
On Error GoTo ProcError
If Not (rsData.BOF And rsData.EOF) Then
rsData.MoveLast()
Call addData(rsData)
Else
Call addData(rsData)
End If
conn.CommitTrans()
MsgBox("Patient's Record Saved Successfully...!", MsgBoxStyle.Information, "Patient Registration")
Call loadDataListview()
Call fieldDisable()
Call Disable_SearchButtons()
btnSave_Click = True
comDepart.Enabled = False
conn.Close()
ProcError:
If Err.Number <> 0 Then
conn.RollbackTrans()
MsgBox(Err.Number & " " & Err.Description)
Call addNewR()
Exit Sub
End If
End Sub
Private Sub addData(rData As ADODB.Recordset)
Dim rsPaymentType As New ADODB.Recordset
'Dim str As String
If Not (rData.BOF And rsData.EOF) Then
rData.MoveFirst()
If rData.RecordCount > 0 Then
Do
If txthn.Text = rData("hNumber").Value Then
Call addVisit()
conn.Execute("update tblPatientRecord set visitNo = '" & vNo.Text & "' where hNumber = '" & txthn.Text & "'")
Call fieldEnable()
Exit Sub
End If
rData.MoveNext()
Loop Until rData.EOF
End If
End If
rData.AddNew()
rData("hNumber").Value = txthn.Text
rData("fName").Value = txtfn.Text
rData("contactNo").Value = txtContact.Text
rData("address").Value = txtaddress.Text
rData("cnic").Value = txtcnic.Text
'rData("cnic").Value = rCNIC()
rsData("visitNo").Value = vNo.Text
rsData("cnicSD").Value = comSD.Text
''Add gender as selected
If radmale.Checked = True Then
rData("gender").Value = radmale.Text
ElseIf radfemale.Checked = True Then
rData("gender").Value = radfemale.Text
Else
rData("gender").Value = " - "
End If
If txtAge.Text < 105 Or Year(dtAgePicker.Value) < 1915 Then
Call addAge()
'MsgBox("data of tblAge added")
Else
MsgBox("Please Enter Correct Age ", vbCritical, "")
txtAge.Select()
Exit Sub
End If
If comRelation.Text = "Select Relation with Patient" Or comRelation.Text = "" Then
comRelation.Text = "Not Selected"
End If
If txtfh.Text = "" Then
txtfh.Text = "Not Given"
End If
Call addRelation()
'Save Department ID as selected
If comDepart.Text <> "Select Department" Then
Call addVisit()
'MsgBox("data of tblVisit added")
Else
MsgBox("Please Enter the Department ", vbCritical, "")
comDepart.Select()
Exit Sub
End If
If Not rsPaymentType Is Nothing Then
If rsPaymentType.State = 0 Then
Call openRecordset("Select * from tblPaymentType", rsPaymentType)
'MsgBox("Patient record is open" & rsData.State)
End If
Else
Call openRecordset("Select * from tblPaymentType", rsPaymentType)
'MsgBox("Patient record is open")
End If
If Not (rsPaymentType.BOF And rsPaymentType.EOF) Then
rsPaymentType.MoveFirst()
Do
If rsPaymentType("paymentType").Value = comPaymentType.Text Then
rData("paymentType").Value = rsPaymentType("paymentTypeID").Value
Exit Do
Else
rData("paymentType").Value = 0
End If
rsPaymentType.MoveNext()
Loop Until rsPaymentType.EOF
End If
rsData.Update()
End Sub
Public Function h_N0_Generator(rs As ADODB.Recordset) As String
Dim str, p1() As String
Dim auto_long As Long
Dim hMonth As String
Dim strCounter As String, temp As String
'this counter file is added to make the hNumber unique for multiple counter /* in the file counter number is added and have respective counter number only*/
FileOpen(FileNum, "C048ounter.txt", OpenMode.Input)
strCounter = LineInput(FileNum)
FileClose(FileNum)
If strCounter = "" Then
strCounter = "1"
End If
hMonth = Month(Now).ToString("D2")
If (rs.EOF And rs.BOF) Then
h_N0_Generator = "NIRM-" & Year(Now) & "-" & hMonth & "-" & "00000" & strCounter
Else
rs.MoveLast()
str = rs("HNumber").Value
p1 = str.Split("-")
' check if the current month is the same as in last stored Hospital No or not
'if yes the last five digits increment otherwise it restarts with 0
If p1(2) = Month(Now) And p1(1) = Year(Now) Then
temp = Right(rs(0).Value, 6)
auto_long = Left(temp, 5) + 1
h_N0_Generator = "NIRM-" & Year(Now) & "-" & hMonth & "-" & Right("00000" & auto_long, 5) & strCounter
Else
h_N0_Generator = "NIRM-" & Year(Now) & "-" & hMonth & "-" & "00000" & strCounter
End If
End If
'Return auto_num
End Function
I've created a Windows Form application. It is my understanding that you do not have to have a Sub Main() in a Windows Form app. However I'm getting this error when I build my project:
BC30420 'Sub Main' was not found in 'LoanCalculator.Module1'.
First of all I don't know why it's saying 'LoanCalculator.Module1'. Both my form and my class are named LoanCalculator.vb. When I started the project I started writing the code in the original module. Then I added a module, named it 'LoanCalculator' and moved what code I had written to that module and finished it there. I deleted the original module. Now it builds fine with the exception of this one error. Here's my code:
Imports System.Windows.Forms
Public Class LoanCalculator
Private Sub Calculate()
Dim str As String
Dim intLoanAmt As Integer
Dim intDown As Integer
Dim intFees As Integer
Dim intBalance As Integer
Dim dblIntsRate As Single
Dim intLoanTerm As Integer
Dim sngInterestPaid As Single
Dim intTermMonths As Integer
Dim dblMonthlyPmt As Integer
Dim intTotalPaid As Integer
Dim dblYon As Double
Dim dblXon As Double
Dim dblZon As Double
If Not CheckInput() Then
Return
End If
intLoanAmt = Convert.ToInt32(txtLoan.Text)
intFees = Convert.ToInt32(txtFees.Text)
intDown = Convert.ToInt32(txtDown.Text)
intBalance = Convert.ToInt32(intLoanAmt - intDown + intFees)
intLoanTerm = Convert.ToInt32(txtTerm.Text)
dblIntsRate = Convert.ToDouble(txtTerm.Text)
intTermMonths = intLoanTerm * 12
dblYon = dblIntsRate / 1200
dblXon = dblYon + 1
dblZon = Math.Pow(dblXon, intTermMonths) - 1
dblMonthlyPmt = (dblYon + (dblYon / dblZon)) * intBalance
intTotalPaid = dblMonthlyPmt * intTermMonths
sngInterestPaid = intTotalPaid - intBalance
str = "Loan balance =" & Space(11) & intBalance.ToString & vbCrLf
str = str & "Loan Term =" & Space(16) & intLoanTerm.ToString & " years" & vbCrLf
str = str & "Interest paid =" & Space(17) & intTotalPaid.ToString & vbCrLf
str = str & "Monthly payment =" & Space(5) & dblMonthlyPmt.ToString
lblResults.Text = str
End Sub
Private Function CheckInput() As Boolean
Dim strErr As String = ""
If txtLoan.Text.Length = 0 Then
strErr = "Enter loan amount" & vbCrLf
End If
If txtDown.Text.Length = 0 Then
strErr = strErr & "Enter down payment" & vbCrLf
End If
If txtInterest.Text.Length = 0 Then
strErr = strErr & "Enter interest rate" & vbCrLf
End If
If txtFees.Text.Length = 0 Then
strErr = strErr & "Enter fees" & vbCrLf
End If
If txtTerm.Text.Length = 0 Then
strErr = strErr & "Enter loan term" & vbCrLf
End If
If strErr.Length > 0 Then
MessageBox.Show(strErr)
Return False
Else
Return True
End If
End Function
End Class
How can I fix this?
I have a vba code that scan image from scanner , the code works and doesnt have any problem with type hp an brother scanner but when I used it with canon can not find the scanner and send message no wia device. How can solve this problem
Private Sub Command10_Click()
Const wiaFormatJPEG = "{B96B3CAE-0728-11D3-9D7B-0000F81EF32E}"
On Error GoTo Handle_Err
Dim Dialog1 As New WIA.CommonDialog, DPI As Integer, PP As Integer, l As Integer
Dim Scanner As WIA.Device
Dim img As WIA.ImageFile
Dim intPages As Integer
Dim strFileJPG As String
Dim blnContScan As Boolean ' to activate the scanner to start scan
Dim ContScan As String 'msgbox to chk if more pages are to be scanned
Dim strFilePDF As String
Dim RptName As String
Dim strProcName As String
strProcName = "ScanDocs"
DoCmd.SetWarnings False
DoCmd.RunSQL "delete from scantemp"
DoCmd.SetWarnings False
blnContScan = True
intPages = 0
Do While blnContScan = True
DPI = 200
PP = 1 'No of pages
Set Scanner = Dialog1.ShowSelectDevice(WIA.WiaDeviceType.ScannerDeviceType, True, False)
Set img = Dialog1.ShowTransfer(Scanner.Items(1), wiaFormatJPEG, True)
strFileJPG = ""
intPages = intPages + 1
strFileJPG = "\\User-pc\saveimage\" & num & Trim(str(intPages)) & ".jpg"
img.SaveFile (strFileJPG)
DoCmd.RunSQL "insert into scantemp (picture) values ('" & strFileJPG & "')"
DoCmd.SetWarnings False
Set Scanner = Nothing
Set img = Nothing
' strFileJPG = ""
'Prompt user if there are additional pages to scan
ContScan = MsgBox("?save another page ", vbQuestion + vbYesNoCancel)
If ContScan = vbNo Then
blnContScan = False
ElseIf ContScan = vbCancel Then
DoCmd.RunSQL "delete from scantemp where picture = '" & strFileJPG & "'"
End If
'''''''''''''''
Loop
Dim Image_Path As String
GoTo StartPDFConversion
StartPDFConversion:
Dim s As String
strFilePDF = "\\User-pc\saveimage\" & (num) & ".pdf"
RptName = "rptScan"
DoCmd.OpenReport RptName, acViewReport, , , acHidden
DoCmd.Close acReport, RptName, acSaveYes
DoCmd.OutputTo acOutputReport, RptName, acFormatPDF, strFilePDF
Me.imgp = strFilePDF
DoCmd.RunSQL "delete from scantemp" 'delete all data from table scantemp after converted it to pdf
'/*******************************\
'/********************************************\
Handle_Exit:
Exit Sub
Handle_Err:
Select Case Err.Number
Case 2501
Resume Handle_Exit
Case Else
MsgBox "the." & vbCrLf & vbCrLf & _
"In Function:" & vbTab & strProcName & vbCrLf & _
"Err Number: " & vbTab & Err.Number & vbCrLf & _
"Description: " & vbTab & Err.Description, 0, _
"Error in " & Chr$(34) & strProcName & Chr$(34)
Resume Handle_Exit
End Select
Exit Sub
End Sub
Option Compare Database
Private Declare Function TWAIN_AcquireToFilename Lib "TWAIN32d.DLL" (ByVal hwndApp As Long, ByVal bmpFileName As String) As Integer
Private Declare Function TWAIN_IsAvailable Lib "TWAIN32d.DLL" () As Long
Private Declare Function TWAIN_SelectImageSource Lib "TWAIN32d.DLL" (ByVal hwndApp As Long) As Long
Private Sub cmdScan_Click()
Dim Ret As Long, PictureFile As String
Dim intPages As Integer
Dim blnContScan As Boolean
Dim ContScan As String 'msgbox to chk if more pages are to be scanned
blnContScan = True
intPages = 0
Do While blnContScan = True
DPI = 200
PP = 1 'No of pages
intPages = intPages + 1
PictureFile = CurrentProject.Path & "\" & myfolder & "\" & Me.number & Trim(Str(intPages)) & ".jpg"
Ret = TWAIN_AcquireToFilename(Me.hwnd, PictureFile)
ContScan = MsgBox("? ÍÝÙ ÕæÑÉ ÇÎÑì ", vbQuestion + vbYesNo, "ÊäÈíÉ")
If ContScan = vbNo Then
blnContScan = False
End If
Loop
I'm attempting to fix some botched up VBA from someone whom I inherited this Access database from. Aside from the hardly-useful notes left in VBA, there is no documentation, so I am trying to figure out what everything does, and if it is correct. I continue getting a 13Type Mismatch error when I am Clicking a button to add either units or a value to a table of Contributions. I thought it was an easy fix such as a messed up variable declaration, however I've changed them to Double and it didn't seem to correct my error. Does anyone see anything off the bat that they might recognize as throwing this error? Thanks ahead of time for your efforts.
Private Sub AddContributionBtn_Click()
On Error GoTo Err_AddContributionBtn
Dim Cancel As Integer
Dim CurrentNAVDate As Date
Dim CurrentNAV As Double
Dim ConfirmAddCont As Double
Dim CalcContUnits As Double
Dim CalcContValue As Double
Dim StringSQL As String
'get current NAV
CurrentNAVDate = Format(DateAdd("s", -1, DateAdd("q", DateDiff("q", "1/1/1900", Date), "1/1/1900")), "Short Date")
CurrentNAV = Format(DLookup("NetAssetValue", "NAV_Tbl", "Format(NAV_Date, ""mmddyyyy"") = " & Format(CurrentNAVDate, "mmddyyyy")), "Currency")
'validation to require either contribution units or value is entered, not both
If IsNull(Me.ContValueTxt) = True And IsNull(Me.ContUnitsTxt) = True Then
MsgBox "Please enter contribution units or value."
Me.ContUnitsTxt.SetFocus
Cancel = True
Exit Sub
ElseIf IsNull(Me.ContValueTxt) = False And IsNull(Me.ContUnitsTxt) = False Then
MsgBox "Both contribution units and value may not be entered."
Me.ContUnitsTxt.SetFocus
Cancel = True
Exit Sub
Else:
If IsNull(Me.ContValueTxt) = True And IsNull(Me.ContUnitsTxt) = False Then
'calculate contribution value from units
CalcContUnits = Me.ContUnitsTxt
CalcContValue = CalcContUnits * CurrentNAV
GoTo ConfirmAppend
ElseIf IsNull(Me.ContValueTxt) = False And IsNull(Me.ContUnitsTxt) = True Then
'calculate contribution units from value
CalcContValue = Me.ContValueTxt
CalcContUnits = CalcContValue / CurrentNAV
GoTo ConfirmAppend
End If
End If
ConfirmAppend:
'confirm contribution value and units, run append query
ConfirmAddCont = MsgBox("Add " & Format(CalcContUnits, "fixed") & " units for a contribution value of " & Format(CalcContValue, "currency") & "?", _
vbOKCancel, "Add Contribution")
If ConfirmAddCont = vbOK Then
DoCmd.Hourglass True
DoCmd.SetWarnings False
StringSQL = "INSERT INTO ContributionTbl(ContDate, ContUnits, ContNAV, ContType) VALUES (#" & Date & "#, " & CalcContUnits & ", #" & CurrentNAVDate & "#, " & 1 & ");"
DoCmd.RunSQL (StringSQL)
DoCmd.SetWarnings True
DoCmd.Hourglass False
Me.ContUnitsTxt = Null
Me.ContValueTxt = Null
Forms!PlanFrm![PlanContributedUnitsFrm].Requery
Else
Cancel = True
Exit Sub
End If
Exit_AddContributionBtn:
Exit Sub
Err_AddContributionBtn:
MsgBox Err.Number & Err.Description
Resume Exit_AddContributionBtn
End Sub
As shown in the discussion, I make our guess clearer in this temporary reponse:
Error may be here:
CurrentNAV = Format(DLookup("NetAssetValue", "NAV_Tbl", "Format(NAV_Date, ""mmddyyyy"") = " & Format(CurrentNAVDate, "mmddyyyy")), "Currency")
as DLookup("NetAssetValue",...) gets NULL,
Format(NULL, "Currency") gets 13 Type Mismatch, as I've reproduced this in Access 2007.
This can be explained:
Since there is no recent date in the table field NAV_Tbl.NetAssetValue, as in the case we get the date CurrentNAVDate = 09/30/2013 (last date of the last quarter).
So you may try code like this, by introducing varCurrency variable to handle this NULL value case:
Private Sub AddContributionBtn_Click()
On Error GoTo Err_AddContributionBtn
Dim Cancel As Integer
Dim CurrentNAVDate As Date
Dim CurrentNAV As Double
Dim ConfirmAddCont As Double
Dim CalcContUnits As Double
Dim CalcContValue As Double
Dim StringSQL As String
Dim varCurrency
'get current NAV
CurrentNAVDate = Format(DateAdd("s", -1, DateAdd("q", DateDiff("q", "1/1/1900", Date), "1/1/1900")), "Short Date")
varCurrency = DLookup("NetAssetValue", "NAV_Tbl", "Format(NAV_Date, ""mmddyyyy"") = " & Format(CurrentNAVDate, "mmddyyyy"))
If(IsNull(varCurrency) then
CurrentNAV = 0
Else
CurrentNAV = Format(varCurrency, "Currency")
End If
'validation to require either contribution units or value is entered, not both
If IsNull(Me.ContValueTxt) = True And IsNull(Me.ContUnitsTxt) = True Then
MsgBox "Please enter contribution units or value."
Me.ContUnitsTxt.SetFocus
Cancel = True
Exit Sub
ElseIf IsNull(Me.ContValueTxt) = False And IsNull(Me.ContUnitsTxt) = False Then
MsgBox "Both contribution units and value may not be entered."
Me.ContUnitsTxt.SetFocus
Cancel = True
Exit Sub
Else:
If IsNull(Me.ContValueTxt) = True And IsNull(Me.ContUnitsTxt) = False Then
'calculate contribution value from units
CalcContUnits = Me.ContUnitsTxt
CalcContValue = CalcContUnits * CurrentNAV
GoTo ConfirmAppend
ElseIf IsNull(Me.ContValueTxt) = False And IsNull(Me.ContUnitsTxt) = True Then
'calculate contribution units from value
CalcContValue = Me.ContValueTxt
CalcContUnits = CalcContValue / CurrentNAV
GoTo ConfirmAppend
End If
End If
ConfirmAppend:
'confirm contribution value and units, run append query
ConfirmAddCont = MsgBox("Add " & Format(CalcContUnits, "fixed") & " units for a contribution value of " & Format(CalcContValue, "currency") & "?", _
vbOKCancel, "Add Contribution")
If ConfirmAddCont = vbOK Then
DoCmd.Hourglass True
DoCmd.SetWarnings False
StringSQL = "INSERT INTO ContributionTbl(ContDate, ContUnits, ContNAV, ContType) VALUES (#" & Date & "#, " & CalcContUnits & ", #" & CurrentNAVDate & "#, " & 1 & ");"
DoCmd.RunSQL (StringSQL)
DoCmd.SetWarnings True
DoCmd.Hourglass False
Me.ContUnitsTxt = Null
Me.ContValueTxt = Null
Forms!PlanFrm![PlanContributedUnitsFrm].Requery
Else
Cancel = True
Exit Sub
End If
Exit_AddContributionBtn:
Exit Sub
Err_AddContributionBtn:
MsgBox Err.Number & Err.Description
Resume Exit_AddContributionBtn
End Sub
For DLookup():
varCurrency = DLookup("NetAssetValue", "NAV_Tbl", "NAV_Date >= #" & Format(CurrentNAVDate, "yyyy-mm-dd") & "#")