I try to run the code below but i get a syntax error (missing operator) in line 3. I`m unable to figure out what is missing.
Dim mains As Recordset
Set mains = CurrentDb.OpenRecordset("MAIN CAMPUS MINOR POSITION APPLICANTS", dbOpenSnapshot, dbReadOnly)
mains.FindFirst "1st SECONDER='" & Nz(Me.txtmain, "") & "'"
If mains.NoMatch = True Then
Me.txtmain.BackColor = vbGreen
txtnakuru.SetFocus
Else
MsgBox "Duplicate First Seconder. Please Revise your Seconders.", vbExclamation, ""
Me.txtmain.Value = ""
What might i be ommiting.
Related
I have a form that if a duplicate record is entered, the form creates an error message and prevents the record from being entered. However, my code is popping up the error message no matter what I'm putting in. My code is this...
Private Sub cmdSave_Click()
' ToDo fix the labels in this function so they match the function name. Just cosmetic.
On Error GoTo Add_CmdSave_Click_Err
On Error Resume Next
' ToDo fix the labels in this function so they match the function name. Just cosmetic.
On Error GoTo Add_CmdSave_Click_Err
On Error Resume Next
Me.cbCompletedTrainingID = Me.IntermediateID
'
Dim OKToSave As Boolean
OKToSave = True
If Not SomethingIn(Me.[fIntermediate FacultyID]) Then ' Null
Beep
MsgBox "A faculty member is required", vbOKOnly, "Missing Information"
OKToSave = False
End If
If Not SomethingIn(Me.[fIntermediate TrainingID]) Then
Beep
MsgBox "A training is required", vbOKOnly, "Missing Information"
OKToSave = False
Else
Dim rs As Object
Set rs = Me.Recordset.Clone
rs.FindFirst "[IntermediateID] = " & Me.[fIntermediate FacultyID] And Me.[fIntermediate TrainingID]
If Not rs.EOF Then
Beep
MsgBox "This person has already completed this training", vbOKOnly, "Duplicate Training Completion"
OKToSave = False
End If
End If
If OKToSave Then
' If we get this far, all data is valid and it's time to save
Me.Dirty = False
DoCmd.GoToRecord , "", acNewRec
End If
Add_CmdSave_Click_Exit:
Exit Sub
Add_CmdSave_Click_Err:
Resume Add_CmdSave_Click_Exit
End Sub
The issue, from my standpoint, lies in this part...
Dim rs As Object
Set rs = Me.Recordset.Clone
rs.FindFirst "[IntermediateID] = " & Me.[fIntermediate FacultyID] And Me.[fIntermediate TrainingID]
If Not rs.EOF Then
Beep
MsgBox "This person has already completed this training", vbOKOnly, "Duplicate Training Completion"
OKToSave = False
End If
What am I doing wrong?
Have a look at How to debug dynamic SQL in VBA.
This line makes no sense as it is:
rs.FindFirst "[IntermediateID] = " & Me.[fIntermediate FacultyID] And Me.[fIntermediate TrainingID]
You probably want something like
S = "[IntermediateID] = " & Me.[fIntermediate FacultyID] & " And [TrainingID] = " & Me.[fIntermediate TrainingID]
Debug.Print S ' Ctrl+G shows the output
rs.FindFirst S
Also, remove all these On Error Resume Next - this will happily ignore any errors, making debugging nearly impossible.
Also useful: Debugging VBA Code
And there is more: If Recordset.FindFirst doesn't find a match, it doesn't trigger .EOF. It sets the .NoMatch property.
rs.FindFirst S
If rs.NoMatch Then
' all is good, proceed to save
Else
' record exists
End If
This should work as intended:
Dim rs As DAO.Recordset
Dim Criteria As String
Set rs = Me.RecordsetClone
Criteria = "[IntermediateID] = " & Me![fIntermediate FacultyID].Value & " And [TrainingID] = " & Me![fIntermediate TrainingID].Value & ""
Debug.Print OKToSave, Criteria
rs.FindFirst Criteria
If Not rs.NoMatch Then
Beep
MsgBox "This person has already completed this training", vbInformation + vbOKOnly, "Duplicate Training Completion"
OKToSave = False
End If
rs.Close
Debug.Print OKToSave
I'm new to VBA and word macros so please bear with me.
I've created a simple form and now I just want to do some validation on a button, before emailing it.
I've got some code here.
Private Sub CommandButton1_Click()
Dim errors As String
errors = ""
Dim strText As String
strText = ActiveDocument.SelectContentControlsByTitle("MyField")(1).Range.Text
errors = strText //debugging line - remove if required
If strText = "" Then
If errors = "" Then
errors = "MyField Blank"
Else
errors = errors & vbNewLine & "Practise Name Blank"
End If
End If
If errors = "" Then
Options.SendMailAttach = True
ActiveDocument.SendMail
Else
MsgBox "Please Correct Then Following Errors" & vbNewLine & errors
End If
End Sub
Which is attached to a button, but the strText is returning back the placeholder text. How do you stop this from happening?
I'm using the new version of the word forms controls.
Given what you write, my approach to this would be to check the placeholder text and compare the content control's content with that. If they're the same, it's as if the content control had no content.
Note that I'm unsure what is intended with the last IF-block since, given the preceding code, errors cannot be an empty (zero-length) string - it would always contain something, based on the If-block preceding. But perhaps this is due to testing the problem with the placeholders...
Dim errors As String, ph As String
Dim cc As Word.ContentControl
errors = ""
Dim strText As String
Set cc = ActiveDocument.SelectContentControlsByTitle("MyField")(1)
ph = cc.PlaceholderText
strText = cc.Range.Text
errors = strText
If strText = "" Or strText = ph Then
If errors = "" Or strText = ph Then
errors = "MyField Blank"
Else
errors = errors & vbNewLine & "Practise Name Blank"
End If
End If
If errors = "" Then
Options.SendMailAttach = True
ActiveDocument.SendMail
Else
MsgBox "Please Correct Then Following Errors" & vbNewLine & errors
End If
I cannot find any errors in my code, however the "object required" error keeps coming up.
Can somebody please help. I have been on this, trying to fix it for half an hour and I still cant find the problem. Any help would be appreciated.
Thanks!
Private Sub cmdCost_Click()
Dim strCost As Integer
Dim strFixedCost As Integer
Dim strResourceCost As Integer
Dim wksResources As Worksheet
Set wksResources = Application.Workbooks(1).Worksheets("Resources")
Set strFixedCost = 140
If cResources.Text = "" = False Then
If Val(tQuantity.Text) > 0 Then
wksResources.Select
wksResources.Range("B2").Select
Do Until ActiveCell.Value = cResources.Text
ActiveCell.Offset(1, 0).Select
Loop
Set strResourceCost = ActiveCell.Offset(0, 3).Value
Set strCost = strFixedCost + (Val(strResourceCost) * tQuantity)
MsgBox " The price is" & " $" + strCost, Buttons:=vbOKOnly, Title:="Cost"
Else
MsgBox " You have not chosen a quantity.", Buttons:=vbOKOnly, Title:="Cost"
End If
Else
MsgBox " You have not chosen a resource.", Buttons:=vbOKOnly, Title:="Cost"
End If
End Sub
I could see a few issues with your code:
1. You are using 'Set' to initialize strCost, strFixedCost & strResourceCost which is not required. Just write:
strFixedCost = 140
Also, your 1st IF condition is quite confusing. I suppose you are checking if value is present in cResources variable (you haven't mentioned where you are getting cResources & tQuantity values). in that case you can just use If Len(cResources) > 0 Then
Your 1st msgbox will give you a type mismatch error as you are combining string with an integer.
MsgBox " The price is" & " $" + strCost, Buttons:=vbOKOnly, Title:="Cost"
Instead you can use the below code to convert strCost to string:
MsgBox " The price is" + " $" + CStr(strCost), Buttons:=vbOKOnly, Title:="Cost"
I have the following code, this code was written in VB6 but i can not open the form or check any references.
Private Sub PopulatePrinterCombo(cmbDestination As ComboBox)
Dim objPrinter As Printer 'a printer in the Printers collection object
'Add the printers to the combo box
For Each objPrinter In printers
cmbPrinter.AddItem objPrinter.DeviceName
Next
'Set current selection to the default printer
cmbDestination.Text = Printer.DeviceName
End Sub
I am currently copying the code onto Excel VBA macro, the problem is the Dim objPrinter As Printer code, i keep getting an error message saying "USER DEFINED TYPE NOT DEFINED", do i need a reference to add on VBA to be able to get the option of declaring a variable as a "Printer" or something?
My second question is that i do not fully understand the "Printers" in the line For Each objPrinter In printers, what is "Printers"? can someone please explain that to me.
Thank you
PART 2
I am now trying to print files, i have the following as my code:
'Initialize values
intDraftsPrinted = 0
If objDraftPaths.Count > 1 Then
Else
intSelectedDraftCount = CountSelectedDrafts
End If
'prompt user to make sure
intMsgBoxResponse = MsgBox("You selected " & intSelectedDraftCount & " part numbers. After removing duplicates" & vbNewLine & "there were " & objDraftPaths.Count & " unique draft files found." & vbNewLine & "Do you want to print these files?", vbYesNo, "TD Printer")
If intMsgBoxResponse <> vbYes Then
intSelectedDraftCount = 0 'So the following for loop will not entered
Else
intSelectedDraftCount = objDraftPaths.Count
End If
For i = 1 To intSelectedDraftCount
booSuccess = False
'open the draft file
Set objDraftDocument = OpenSolidEdgeDraft(objDraftPaths.Item(i))
If objDraftDocument Is Nothing Then
'could not open file
MsgBox "Could not open the following draft file:" & vbNewLine & _
objDraftPaths.Item(i), vbExclamation, "Solid Edge Error"
Else
'Print the draft file
For Each objSheet In objDraftDocument.Sheets
strSheetSize = DetermineSheetSize(objSheet)
If strSheetSize <> "" Then
'Determine orientation
If InStr(1, strSheetSize, "90") <> 0 Then
'Print as landscape
intOrientation = vbPRORLandscape
Else
'Print as portrait
intOrientation = vbPRORPortrait
End If
'Specify Sheet Size
Select Case Left(strSheetSize, 1)
Case "A"
intPaperSize = VBRUN.PrinterObjectConstants.vbPRPSLetter
Case "B"
intPaperSize = VBRUN.PrinterObjectConstants.vbPRPS11x17
Case "C"
intPaperSize = VBRUN.PrinterObjectConstants.vbPRPSCSheet
Case "D"
intPaperSize = VBRUN.PrinterObjectConstants.vbPRPSDSheet
Case "E"
intPaperSize = VBRUN.PrinterObjectConstants.vbPRPSESheet
Case Else
intPaperSize = VBRUN.PrinterObjectConstants.vbPRPSLetter
End Select
'Enable error handling
On Error Resume Next
'Activate the current sheet
objSheet.Activate
If Err Then
'Could not activate sheet
MsgBox "An error occurred while attempting to print: " & vbNewLine & objDraftPaths.Item(i) & vbNewLine & "The error was:" & vbNewLine & "Error Number: " & Err.Number & vbNewLine & "Error Description: " & Err.Description, vbExclamation, "Solid Edge Error"
Err.Clear
Else
'Print to the printer specified by the combo box
objDraftDocument.PrintOut cmbPrinter.Text, 1, intOrientation, intPaperSize, , , , igPrintSelected
If Err Then
'Could not print document
MsgBox "An error occurred while attempting to print: " & vbNewLine & objDraftPaths.Item(i) & vbNewLine & "The error was:" & vbNewLine & "Error Number: " & Err.Number & vbNewLine & "Error Description: " & Err.Description, vbExclamation, "Solid Edge Error"
Err.Clear
Else
booSuccess = True
End If
End If
'Disable error handling
On Error GoTo 0
End If
Next
'Close the file
objDraftDocument.Close False
intDraftsPrinted = intDraftsPrinted + 1
End If
Next i
'Dereference objects
Set objSheet = Nothing
Set objDraftDocument = Nothing
'Set objDraftPaths = Nothing
PrintSelectedDrafts = intDraftsPrinted
Now the problem comes when i hits the line that says: intOrientation = vbPRORLandscape
in excel VBA, it does not recognize "vbPRORLandscape" as well as the next line "vbPRORPortrait". Is there a way to fix that?
Also, i have a feeling that VBRUN.PrinterObjectConstants.vbPRPSLetter and the rest of those lines might not work out as well. It works in VB6 though.
Thank you
It appears the Printers Collection is available in the MS Access VBA environment but I do not believe it is intrinsic to the Excel VBA environment.
I use the WshNetwork object of Windows Script Host to list the available printers. I use the subroutine below to populate a ComboBox with the list of printers that are connected to the system. In order for this code to work you will need to add the "Windows Script Host Object Model" reference to your VBA project. (Menu: Tools > References [Select from list])
I added the (j) loop to alphabetize the list.
Sub populatePrintersList()
Dim nwo As New WshNetwork
Dim i As Integer
Dim j As Integer
Dim bAdd As Boolean
bAdd = True
cmbPrinter.Clear
For i = 0 To (nwo.EnumPrinterConnections.Count / 2) - 1
For j = 0 To cmbPrinter.ListCount - 1
If nwo.EnumPrinterConnections(i * 2 + 1) < cmbPrinter.List(j) Then
cmbPrinter.AddItem nwo.EnumPrinterConnections(i * 2 + 1), j
bAdd = False
Exit For
End If
Next j
If bAdd Then cmbPrinter.AddItem nwo.EnumPrinterConnections(i * 2 + 1): bAdd = True
Next i
cmbPrinter.ListIndex = 0
End Sub
Part 2:
MSDN contains reference material for the Worksheet.PrintOut method: Worksheet.PrintOut
In depth documentation for the methods and properties of the Worksheet.PageSetup object can also be found on MSDN: Worksheet.PageSetup
I suggest using these resources to find a plethora of answers.
Good Afternoon,
I am looking for a way to handle QueryTable Errors. I have looked at other questions on google and stackoverflow, however they do not appear to answer the specific question i am trying to ask.
Basically, is there a way to determine what the specific error was when handling a QueryTables error?
Code:
On Error Goto queryError
With Activesheet.QueryTables...
....
End With
queryError:
Msgbox("There was an error with the QueryTables. The reason for the error was: " & myError)
Is there a way to set myError to give more details specific to what the problem was, even if it means selecting some sort of status code? eg
QueryTables.StatusCode...
or something?
Thanks in advance.
How to handle errors:
Excel VBA doesn't supportTry Catch Finally. Instead, it uses On Error GoTo
For full control over error-handling in Excel you must use labels (which always end in a colon).
In this example, the two labels are:
tryAgain:
queryError:
Assume that the Query Table being created is from a text file that looks something like:
When you first run the routine, the user is prompted for three inputs:
Filepath
New Table Name
Cell (i.e. Range) to paste into
If an error occurs on any of these inputs, the code will immediately go to the label queryError:
So, say the user didn't enter in a valid filepath, it would look something like this:
If the user clicks Yes (to try again), then Resume tryAgain will take the code back up to that label and go through it all over.
Pay attention to the Select Case at the end. This is how you can control how you want to handle specific errors.
Here is the code to paste in a module:
Option Explicit
Sub CreateQueryTable()
'Assign values to these variables by prompting user with Input Boxes
Dim filepath As String
Dim qryTableName As String
Dim startCellForTable As Range
'These variables are used in the error handling prompts
Dim Msg As String
Dim Ans As Integer
'If an error occurs, code will go to the label `queryError:`
On Error GoTo queryError
tryAgain:
'Prompt user for the filename of the .txt file to use as QueryTable Source
filepath = InputBox("Please enter filepath of text file to use as the source")
'Prompt user to name the new Query Table
qryTableName = InputBox("Please enter name of Query Table")
'Prompt user for the cell to put table at
Set startCellForTable = Application.InputBox(Prompt:="Please select a cell where you would like to paste the table to", Type:=8)
'If user hits OK, check to see that they at least put something as a value
If filepath <> "" And qryTableName <> "" And startCellForTable <> "" Then
'format filepath variable so can pass it as argument to QueryTables.Add
'Trim any leading or trailing spaces from qryTableName
filepath = "TEXT;" & filepath
qryTableName = Trim(qryTableName)
End If
'Create QueryTable at Range("A1")
With ActiveSheet.QueryTables.Add(Connection:=filepath, Destination:=Range(startCellForTable.Address))
.Name = qryTableName
.Refresh BackgroundQuery:=False
End With
'If there are no errors, exit the procedure (so the `queryError:` code won't execute)
Exit Sub
queryError:
Msg = ""
'Say that an error occured
Msg = Msg & "An error occurred with the Query Table. " & vbNewLine & vbNewLine
'Use Excel's built-in Error object (named `Err`) to show error number and description of error
Msg = Msg & Err.Number & ": " & Error(Err.Number) & vbNewLine & vbNewLine
Select Case Err.Number
'Type mismatch
Case 13
'Object required
Case 424
Msg = Msg & vbNewLine & "Please check that a valid range was selected" & vbNewLine
'Application defined or Object defined error
Case 1004
Msg = Msg & vbNewLine & "Please check that this filepath is correct: " & vbNewLine & vbNewLine & filepath & vbNewLine
Case Else
End Select
'Prompt user to Try Again
Msg = Msg & vbNewLine & vbNewLine & "Try again?"
Ans = MsgBox(Msg, vbYesNo + vbCritical)
'If user says Yes, clear the error, and resume execution of code at label `TryAgain:`
If Ans = vbYes Then Resume tryAgain
End Sub