New to MS Access and was curious if there is a way to tell if a barcode that is scanned is either a FedEx barcode or a UPS barcode. From what I've seen, UPS has alpha numeric barcodes and FedEx has 12 digit numeric barcodes. I'm sure this varies.
I would like to add another column to the table called "Type_TrackNum" that will store whether the label is FedEx or UPS. I would like for this to be attached to the CurrentDB.Execute command.
Here is what I have so far, this also cuts off the leading zeros whenever there are leading zeros, typically found in FedEx barcodes.
Dim strIn As String
Dim i As Integer
Dim iLen As Integer
strIn = Me.txt_Track.Value
iLen = Len(strIn)
For i = 1 To iLen
If InStr(strIn, "0") = 1 Then
strIn = Mid(strIn, 2)
End If
Next i
CurrentDb.Execute _
"INSERT INTO TrackNum_Table(TrackingNum_TrackNum) " & _
"VALUES ('" & strIn & "')"
Any assistance would be helpful.
Something like
Dim strIn As String
Dim strType As String 'NEW
Dim i As Integer
Dim iLen As Integer
strIn = Me.txt_Track.Value
iLen = Len(strIn)
If IsNumeric(strIn) Then
strType = "FedEx"
For i = 1 To iLen
If Left(strIn, 1) = "0" Then
strIn = Mid(strIn, 2)
Else
Exit For
End If
Next i
Else
strType = "UPS"
End If
CurrentDb.Execute _
"INSERT INTO TrackNum_Table(TrackingNum_TrackNum, Type_TrackNum) " & _
"VALUES ('" & strIn & "', '" & strType & "')"
Related
I am working on a custom VBA script that dynamically collects user-entered form data and inserts it into a MySQL database. My problem is, to convert form field data into an SQL script, I have to use string functions; thus, all my data, including dates, gets inserted as text. I need to convert all the dates the form collects from m/d/yyyy format to yyyy-mm-dd format for my MySQL database to infer schema and load date data into DB without an error. I need to do so dynamically, meaning, the script has to work regardless of how many date fields are collected. I have:
Private Sub Submit_Button()
Dim doc as Document
Dim control As ContentControl
Dim FormDateField As Date
Dim ReportNumber As String
Dim myValues As String
Dim myFields As String
Dim conn As ADODB.Connection
Dim strSQL As String
Set doc = Application.ActiveDocument
Set conn = New ADODB.Connection
conn.open "DSN=ABCD"
For Each control In doc.ContentControls
Skip = False
If Left(control.Range.Text, 5) = "Click" Or Left(control.Range.Text, 6) = "Choose" Then
Skip = True
Else:
myFields = myFields & control.Tag
myValues = myValues & "'" & control.Range.Text & "'"
End If
If Not Skip Then
myFields = myFields & ", "
myValues = myValues & ", "
End If
Next
myFields = Left(myFields, Len(myFields) - 2)
myValues = Left(myValues, Len(myValues) - 2)
strSQL = "INSERT INTO TABLE_1 ("
strSQL = strSQL & myFields
strSQL = strSQL & ") VALUES (" & myValues
strSQL = strSQL & ")"
conn.Execute strSQL
MsgBox "Form data saved to database!"
conn.Close
End Sub
However, my program is crashing because it is trying to insert a string into the date field (the actual final form will have many date fields.) I thought if I change the date format to MySQL format, it may be able to infer schema? I tried adding
If IsDate(control.Range.Text) Then
control.Range.Text = Format(control.Range.Text, "yyyy-mm-dd")
Else FoundOne = False
End If
and I know in Excel you can do:
Application.FindFormat.NumberFormat = "m/d/yyyy"
Application.ReplaceFormat = "yyyy-mm-dd"
Any suggestions? Thank you.
Assuming all dates are in date-picker content controls, you could use:
Private Sub Submit_Button()
Dim CCtrl As ContentControl, bSv As Boolean, DtFmt As String
Dim myFields As String, myValues As String, strSQL As String
With ActiveDocument
bSv = .Saved
For Each CCtrl In .ContentControls
With CCtrl
If .ShowingPlaceholderText = False Then
Select Case .Type
Case wdContentControlDate
DtFmt = .DateDisplayFormat
.DateDisplayFormat = "YYYY-MM-DD"
myFields = myFields & .Tag & ", "
myValues = myValues & "'" & .Range.Text & "', "
.DateDisplayFormat = DtFmt
Case wdContentControlRichText, wdContentControlText, wdContentControlDropdownList, wdContentControlComboBox
myFields = myFields & .Tag & ", "
myValues = myValues & "'" & .Range.Text & "', "
Case Else
End Select
End If
End With
Next
.Saved = bSv
End With
If myFields <> "" Then
myFields = Left(myFields, Len(myFields) - 2)
myValues = Left(myValues, Len(myValues) - 2)
strSQL = "INSERT INTO TABLE_1 (" & myFields & ") VALUES (" & myValues & ")"
Dim Conn As New ADODB.Connection
With Conn
.Open "DSN=ABCD": .Execute strSQL: .Close
End With
Set Conn = Nothing
MsgBox "Form data saved to database", vbInformation
Else
MsgBox "No form data found", vbExclamation
End If
End Sub
As you noticed, Word does not have Application.FindFormat or Application.ReplaceFormat, but if you know the format is m/d/y you should be able to do this:
myValues = myValues & "'" & ymd(control.Range.Text) & "'"
Function ymd(s as String) As String
Dim v As Variant
v = VBA.split(s, "/")
ymd = Right("0000" & v(2),4) & "-" & Right("00" & v(0),2) & "-" & Right("00" & v(1),2)
End Function
Everything else (e.g. the way you add commas to the list of dates) looks fine but I have not tested.
I am using this code to call a random alpha numeric string. I am doing so via textbox in an Access Form.
https://www.devhut.net/2010/06/22/ms-access-vba-generate-a-random-string/
I am trying to get it to also validate it's uniqueness in a column in Access. When it fails it should run again. It however fixes that problem by doubling the digits it generates. For example to test this I am running it on a field populated with entries from 01-98. It should generate only a two digit numeric string but it returns a 4 digit.
I'm no coder btw and very unfamiliar with VB. I just rip code off the internet, and pray it works. So I might not understand things when you reply back.
Function GenRandomStr(iNoChars As Integer, _
bNumeric As Boolean, _
bUpperAlpha As Boolean, _
bLowerAlpha As Boolean)
On Error GoTo Error_Handler
Dim AllowedChars() As Variant
Dim iNoAllowedChars As Long
Dim iEleCounter As Long
Dim i As Integer
Dim iRndChar As Integer
Dim varCountOfResults As Integer
varCountOfResults = 1
While varCountOfResults > 0
'Initialize our array, otherwise it throws an error
ReDim Preserve AllowedChars(0)
AllowedChars(0) = ""
'Build our list of acceptable characters to use to generate a string from
'Numeric -> 48-57
If bNumeric = True Then
For i = 48 To 57
iEleCounter = UBound(AllowedChars)
ReDim Preserve AllowedChars(iEleCounter + 1)
AllowedChars(iEleCounter + 1) = i
Next i
End If
'Uppercase alphabet -> 65-90
If bUpperAlpha = True Then
For i = 65 To 90
ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
iEleCounter = UBound(AllowedChars)
AllowedChars(iEleCounter) = i
Next i
End If
'Lowercase alphabet -> 97-122
If bLowerAlpha = True Then
For i = 97 To 122
ReDim Preserve AllowedChars(UBound(AllowedChars) + 1)
iEleCounter = UBound(AllowedChars)
AllowedChars(iEleCounter) = i
Next i
End If
'Build the random string
iNoAllowedChars = UBound(AllowedChars)
For i = 1 To iNoChars
Randomize
iRndChar = Int((iNoAllowedChars * rnd) + 1)
GenRandomStr = GenRandomStr & Chr(AllowedChars(iRndChar))
Next i
varCountOfResults = DCount("userentry", "tamontupd", "userentry = '" & GenRandomStr & "'")
Wend
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
MsgBox "The following error has occured" & vbCrLf & vbCrLf & _
"Error Number: " & Err.Number & vbCrLf & _
"Error Source: GenRandomStr" & vbCrLf & _
"Error Description: " & Err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occured!"
Resume Error_Handler_Exit
End Function
You need to add GenRandomStr = "" at the top of the loop, otherwise a second/third trip through will just add to the existing string.
Refactored a little and untested because I don't have Access:
Function GenRandomStr(iNoChars As Integer, _
bNumeric As Boolean, _
bUpperAlpha As Boolean, _
bLowerAlpha As Boolean)
Dim AllowedChars As String, iEleCounter As Long
Dim i As Long, iRndChar As Long, iNoAllowedChars As Long
If bNumeric Then AllowedChars = "0123456789"
If bUpperAlpha Then AllowedChars = AllowedChars & "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
If bLowerAlpha Then AllowedChars = AllowedChars & "abcdefghijklmnopqrstuvwxyz"
iNoAllowedChars = Len(AllowedChars)
Do
GenRandomStr = ""
For i = 1 To iNoChars
Randomize
iRndChar = Int((iNoAllowedChars * Rnd) + 1)
GenRandomStr = GenRandomStr & Mid(AllowedChars, iRndChar, 1)
Next i
Exit Do
Loop While DCount("userentry", "tamontupd", "userentry = '" & GenRandomStr & "'") > 0
End Function
I have a question dealing with a filter function.
I am fine when using a button to search if there is any related data when I entered a keyword. And my code like,
Private Sub Command112_Click()
Dim strSearch As String
Dim strFilter As String
strSearch = "'*" & Forms![TestForm].SearchInput & "*'"
Debug.Print strSearch
strFilter = _
"[IMSDP] Like " & strSearch & _
" Or [EN8] Like " & strSearch & _
" Or [EN10] Like " & strSearch & _
" Or [Card] Like " & strSearch & _
" Or [Status] Like " & strSearch & _
" Or [IMSDP] Like " & strSearch
Debug.Print strFilter
Me.Filter = strFilter
Me.FilterOn = True
End Sub
But once I want to search more than one keyword, it doesn't work.
And my code like following,
Private Sub Search_Click()
Dim strSearch As Variant
Dim strFilter1 As Variant
Dim strFilter2 As Variant
Dim SpacePosition As Variant
Dim Lstr As Variant
Dim Rstr As Variant
Dim IMSDP1 As Variant
Dim IMSDP2 As Variant
strSearch = "'*" & Forms![tryForm].IMSDPInput & "*'"
Debug.Print strSearch
SpacePosition = InStr(1, [strSearch], " ")
Lstr = Trim(Left([strSearch], [SpacePosition] - 1))
Rstr = Trim(Right([strSearch], Len([strSearch]) - [SpacePosition]))
IMSDP1 = Lstr
IMSDP2 = Rstr
MsgBox "IMSDP1 is " & IMSDP1 & " and IMSDP2 is " & IMSDP2 & ""
strFilter1 = _
"[IMSDP] Like " & IMSDP1 & _
"And [IMSDP] Like " & IMSDP2
Me.Filter = strFilter
Me.FilterOn = True
End Sub
Can anyone help? Thank you.
I am now having the code like follow, (you may think Status = IMSDP)
Private Sub Command14_Click()
Dim Status_Filter As Variant
Dim Status_Input As Variant
Dim SpacePosition As Variant
Dim Status1 As Variant
Dim Status2 As Variant
Status_Input = "'*" & Forms![tryForm].StatusInput & "*'"
SpacePosition = InStr(1, [Status_Input], " ")
If (SpacePosition = 0) Then
Status_Filter = _
"[Status] Like " & Status_Input
Else
Status1 = Left([Status_Input], [SpacePosition] - 1)
Status2 = Right([Status_Input], Len([Status_Input]) - [SpacePosition])
MsgBox "Status1 is " & Status1 & " and Status2 is " & Status2 & ""
Status_Filter = _
"[Status] Like " & Status1 & _
"Or [Status] Like " & Status2
End If
Debug.Print Status_Filter
Me.Filter = Status_Filter
Me.FilterOn = True
End Sub
It works if I only enter one keyword(e.g. "20") to search but fail if I entering something like "20 27".
I only know I can write in Excel like, Range("A1").AutoFilter Field:=5, Criteria1:=Status1, Operator:=xlOr, Criteria2:=Status2 But I have no idea how to do it in Access
If Status field is number type and users always enter 'keywords' separated by a space, consider the following:
Private Sub Command14_Click()
If Not IsNull(Me.StatusInput) Then
Me.Filter = "IN(" & Replace(Me.StatusInput, " ", ",") & ")"
End If
Me.FilterOn = True
End Sub
If they enter separated with comma, even simpler:
Me.Filter = "IN(" Me.StatusInput & ")"
For a text field:
"IN('" & Replace(Me.StatusInput, " ", "','") & "')"
"IN('" & Replace(Me.StatusInput, ",", "','") & "')"
Regardless of code structure, depends on users entering string in textbox correctly and consistently.
If you want more control over the values user can enter, use a multi-select listbox and VBA loops through the listbox selected items to construct the comma separated values criteria. A fairly common topic and many code examples available for looping listbox.
And no array needed after all!
I am trying to use a ComboBox to append a query through a form I built. The Combobox should be optional, but I can't seem to get around the Invalid use of null error. Here is the code I have currently
Dim MyDB As DAO.Database
Dim qdef As DAO.QueryDef
Dim i As Integer
Dim strSQL As String
Dim strWhere As String
Dim strIN As String
Dim Box1 As String
Dim strBox1 As String
Dim flgSelectAll As Boolean
Dim varItem As Variant
Set MyDB = CurrentDb()
'General SQL Code
strSQL = "SELECT * FROM Test1"
'Build the IN string by looping through the listbox
For i = 0 To List6.ListCount - 1
If List6.Selected(i) Then
If List6.Column(0, i) = "_All" Then
flgSelectAll = True
End If
strIN = strIN & "'" & List6.Column(0, i) & "',"
End If
Next i
'Create the WHERE string, and strip off the last comma of the IN string
strWhere = " WHERE [Test1.Brand_Name] in " & _
"(" & Left(strIN, Len(strIN) - 1) & ")"
'Create the AND string
Box1 = Me.Combo8.Value
If IsNull(Me.Combo8.Value) Then
strBox1 = Nz(Me.Combo8.Column(0), "")
Else: strBox1 = " AND [Test1.Population] = '" & Box1 & "'"
End If
If Not flgSelectAll Then
strSQL = strSQL & strWhere & strBox1
End If
MyDB.QueryDefs.Delete "cpwg"
Set qdef = MyDB.CreateQueryDef("cpwg", strSQL)
'Open the query, built using the IN clause to set the criteria
DoCmd.OpenQuery "cpwg", acViewNormal
I have also tried
If IsNull(Box1) Or Box1 = "Null" Then
strBox1 = Nz(Me.Combo8.Column(0), "")
Else: strBox1 = " AND [Test1.Population] = '" & Box1 & "'"
End If
Try:
if isnull(me.combo8) then
Also, I Dont know how your combobox is populated, But Null is different than no data. Perhaps try
if me.combo8.value = "" then
IF IsNull(Trim(me.combo8)) Then
'Do Stuff
End if
I have three listboxes and a date range on a parameter form. I am able to pass all of the Listbox selections with no problem. I cannot seem to find a way or answer to adding a date range to the where clause.
The Date field is Course_Date, and the textbox control names for the dates are Start_Date and End_Date
Option Compare Database
Option Explicit
Private Sub cmdPreviewReports_Click()
On Error GoTo cmdPreviewReports_Err
Dim blnQueryExists As Boolean
Dim cat As New ADOX.Catalog
Dim cmd As New ADODB.Command
Dim qry As ADOX.View
Dim varItem As Variant
Dim strInstructors As String
Dim strCourseType As String
Dim strCourseTypeCondition As String
Dim strRoleType As String
Dim strRoleTypeCondition As String
Dim strCourse_Date As Date
Dim strDateRange As String
Dim strSql As String
' Check for the existence of the stored query
blnQueryExists = False
Set cat.ActiveConnection = CurrentProject.Connection
For Each qry In cat.Views
If qry.Name = "q_Parameter_Form" Then
blnQueryExists = True
Exit For
End If
Next qry
' Create the query if it does not already exist
If blnQueryExists = False Then
cmd.CommandText = "SELECT * FROM q_jt_MCR_Instructor_Roles"
cat.Views.Append "q_Parameter_Form", cmd
End If
Application.RefreshDatabaseWindow
' Turn off screen updating
DoCmd.Echo False
' Close the query if it is already open
If SysCmd(acSysCmdGetObjectState, acQuery, "q_Parameter_Form") = acObjStateOpen Then
DoCmd.Close acQuery, "q_Parameter_Form"
End If
' Build criteria string for Instructors
For Each varItem In Me.lst_Instructors.ItemsSelected
strInstructors = strInstructors & "," & Me.lst_Instructors.ItemData(varItem) & ""
Next varItem
If Len(strInstructors) = 0 Then
strInstructors = "Like '*'"
Else
strInstructors = Right(strInstructors, Len(strInstructors) - 1)
strInstructors = "IN(" & strInstructors & ")"
End If
' Build criteria string for CourseType
For Each varItem In Me.lst_Course_Type.ItemsSelected
strCourseType = strCourseType & "," & Me.lst_Course_Type.ItemData(varItem) & ""
Next varItem
If Len(strCourseType) = 0 Then
strCourseType = "Like '*'"
Else
strCourseType = Right(strCourseType, Len(strCourseType) - 1)
strCourseType = "IN(" & strCourseType & ")"
End If
' Get CourseType condition
If Me.optAndCourseType.Value = True Then
strCourseTypeCondition = " AND "
Else
strCourseTypeCondition = " OR "
End If
' Build criteria string for RoleType
For Each varItem In Me.lst_Role.ItemsSelected
strRoleType = strRoleType & "," & Me.lst_Role.ItemData(varItem) & ""
Next varItem
If Len(strRoleType) = 0 Then
strRoleType = "Like '*'"
Else
strRoleType = Right(strRoleType, Len(strRoleType) - 1)
strRoleType = "IN(" & strRoleType & ")"
End If
' Get RoleType condition
If Me.optAndRoleType.Value = True Then
strRoleTypeCondition = " AND "
Else
strRoleTypeCondition = " OR "
End If
'Build Criteria String for Course_Date
strDateRange = strSql And " Between Me.[Start_Date] AND Me.[End_Date]"
' Build SQL statement
strSql = "SELECT q_jt_MCR_Instructor_Roles.* FROM q_jt_MCR_Instructor_Roles " & _
"WHERE q_jt_MCR_Instructor_Roles.[InstructorID] " & strInstructors & _
strCourseTypeCondition & "q_jt_MCR_Instructor_Roles.[Course_TypesID] " & strCourseType & _
strRoleTypeCondition & "q_jt_MCR_Instructor_Roles.[Roles_ID] " & strRoleType & ";"
' Apply the SQL statement to the stored query
cat.ActiveConnection = CurrentProject.Connection
Set cmd = cat.Views("q_Parameter_Form").Command
cmd.CommandText = strSql
Set cat.Views("q_Parameter_Form").Command = cmd
Set cat = Nothing
' Open the Query
If Not IsNull(cboReports) And cboReports <> "" Then
DoCmd.OpenReport cboReports, acViewPreview ' use acNormal to print without preview
Else
MsgBox ("Please make a Label selection first from the dropdown list to the left.")
cboReports.SetFocus
End If
cboReports = ""
' If required the dialog can be closed at this point
' DoCmd.Close acForm, Me.Name
'Restore screen updating
cmdPreviewReports_Exit:
DoCmd.Echo True
Exit Sub
cmdPreviewReports_Err:
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Error Number: " & Err.Number _
& vbCrLf & "Error Description:" & Err.Description _
, vbCritical, "Error"
Resume cmdPreviewReports_Exit
End Sub
I am also able to provide the database to look at if you wish?
Thank you for helping !!!!!!
William
It could be:
'Build Criteria String for Course_Date.
strDateRange = " And Course_Date Between #" & Format(Me![Start_Date].Value, "yyyy\/mm\/dd") & "# AND #" & Format(Me![End_Date].Value, "yyyy\/mm\/dd") & "#"
strSql = strSql & strDateRange