I have a fixed with txt file that I am trying to parse based on data in a certain position.
I need to loop through the recordsets an have it append into a table.
I am having a problem trying to parse out the initial txt file.
I am using where Mid("AllData", 1, 2) = "BR"
I have the code below. What am I doing wrong?
Sub BR_Records()
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rs As DAO.Recordset
strSQL = "TBL_AllData"
Set rs = CurrentDb.OpenRecordset(strSQL)
With rs
If Not .BOF And Not .EOF Then
.MoveLast
.MoveFirst
While (Not .EOF)
Debug.Print rs.Fields("AllData"); where.Mid("AllData", 1, 2) = "BR"
.MoveNext
Wend
End If
.Close
End With
ExitSub:
Set rs = Nothing
Exit Sub
ErrorHandler:
Resume ExitSub
End Sub
Try this:
With rs
If .RecordCount > 0 Then
.MoveFirst
While Not .EOF
If Mid(.Fields("AllData").Value, 1, 2) = "BR" Then
Debug.Print .Fields("AllData").Value
End If
.MoveNext
Wend
End If
.Close
End With
Related
I'm using VBA in Access 2010 form to populate a Word template with data from my tables.
What I can't achieve so far is inserting a hyperlink in the text.
To make things easier for me I'm inserting all the data into table in the template like this:
Private Sub button_Click()
On Error GoTo myError
Dim objWRD As Object 'Word.Application
Dim objDoc As Object 'Word.Document
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strRecords As String
'open a query and prepare the data'
Set db = CurrentDb()
Set qfd = db.QueryDefs("my_query")
Set rs = qfd.OpenRecordset()
'open a Word template'
Set objWRD = CreateObject("Word.Application")
objWRD.Visible = True
Set objDoc = objWRD.Documents.Add("path_to_my_document_template", , , True)
objWRD.ScreenUpdating = False
'insert records into template'
Dim i As Integer
i = 1
While Not rs.EOF
objDoc.Tables(i).Cell(2, 1).Range.Text = "" & rs("hyperlink")
objDoc.Tables(i).Cell(2, 2).Range.Text = "" & rs("description")
rs.MoveNext
i = i + 1
Wend
rs.Close
Set rs = Nothing
leave:
Exit Sub
myError:
MsgBox Error$
Resume Next
End Sub
Can anyone please help me to insert a working hyperlink to the template into rs("hyperlink") place?
Where you reference the table cell to hold the hyperlink, try this:
objDoc.Hyperlinks.add Anchor:=objDoc.tables(i).Cell(2, 1).Range, _
Address:=rs("hyperlink")
And to add additional text to the same cell (In this case I'm inserting "Text to Insert" prior to the hyperlink.
With objDoc.Tables(i).Cell(2, 1).Range
.Collapse Direction:=wdCollapseStart
.Text = "Text to Insert" & Chr(11)
End With
so your While Loop would look something like this:
Dim i As Integer
i = 1
While Not rs.EOF
objDoc.Hyperlinks.add Anchor:=objDoc.Tables(i).Cell(2, 1).Range, _
Address:=rs("hyperlink")
With objDoc.Tables(i).Cell(2, 1).Range
.Collapse Direction:=wdCollapseStart
.Text = "Text to Insert" & Chr(11)
End With
objDoc.Tables(i).Cell(2, 2).Range.Text = "" & rs("description")
rs.MoveNext
i = i + 1
Wend
I have added DoCmd.Close acQuery, "Import", acSaveNo
And my access window doesn't close even with this line of code.
Option Compare Database
Option Explicit
Public Function Import()
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim intFile As Integer
Dim strFilePath As String
Dim intCount As Integer
Dim strHold
strFilePath = "C:\Transfer\FromSynapseTest\TEST.csv"
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("Import", dbOpenForwardOnly)
intFile = FreeFile
Open strFilePath For Output As #intFile
Do Until rst.EOF
If CDate(rst(3)) >= Date And rst(98) <> 0 Then
For intCount = 0 To rst.Fields.Count - 1
strHold = strHold & rst(intCount).Value & "|"
Next
If Right(strHold, 1) = "|" Then
strHold = Left(strHold, Len(strHold) - 1)
End If
Print #intFile, strHold
End If
rst.MoveNext
strHold = vbNullString
Loop
Close intFile
rst.Close
Set rst = Nothing
DoCmd.Close acQuery, "Import", acSaveNo
End Function
Since I'm calling the function by macro, I don't think I can do
Sub subToCloseForm
DoCmd.Close
End Sub
Also I have tried DoCmd.Close acQuery, " ", acSaveNo based on what I read http://www.blueclaw-db.com/docmd_close_example.htm : If you leave the objecttype and objectname arguments blank (the default constant, acDefault, is assumed for objecttype), Microsoft Access closes the active window
Any help would be greatly appreciated. Thank you.
You don't need code DoCmd.Close acQuery, "Import", acSaveNo at all. This command tries to close a query "Import", but you didn't open this query. You opened a recordset, based on this query and you closed the recordset correctly.
If you need to close the form with name "Import", use
DoCmd.Close acForm, "Import", acSaveNo
If you are looking to close Access completely, use:
Application.Quit
Your line of code DoCmd.Close acQuery, "Import", acSaveNo is not necessary as you are opening a recordset, not the query. rst.close and set rst = nothing is sufficient for memory management.
On a side note, I would recommend including an if statement for stepping through your recordset. If the recordset is blank, you will receive an error if left unchecked. Try inserting your for loop inside this if statement:
If not rst.eof and not rst.bof then
'for loop...
end if
I'm trying to write record set contents to excel sheet. My code is not working when trying to move record set contents to Movefirst. My vba code
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
strSQL = "SELECT * FROM " & qrytable & ""
rst.Open strSQL, cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
Set wsSheet1 = wb.Sheets(conSHT_NAME)
wsSheet1.Cells.ClearContents
wsSheet1.Select
For i = 1 To rst.Fields.Count
wsSheet1.Cells(1, i) = rst.Fields(i - 1).Name
Next i
If rst.EOF Then
MsgBox "inside rst"
rst.MoveFirst
wsSheet1.Range("a2").CopyFromRecordset rst
End If
wsSheet1.Columns("A:Q").EntireColumn.AutoFit
rst.Close
The condition If rst.EOF is becomes true and when i'm trying to move record set to rst.Movefirst the debugging control is moving out of the method and moving to the method from where i'm calling this method and not writing contents to excel.
Test for a null recordset with the following:
If (rst.BOF And rst.EOF) Then
rst.Close: set rst = Nothing
Else
rst.MoveFirst
rst.CopyFromRecordset rst
End If
I have a bound form with several subforms. some of these subforms can 0 or more records, others have 1 or more.
The form is always open in read-only and on it there are an "edit" and a "close" button.
When the user clicks on the edit button I save the content of the current record togehter with all records of the subforms so that when he/she clicks on the close button I can ask wether to save or not and, if not, discard the changes restoring from saved records.
So far this is the code of the edit button (where GclnAllCnts is a global variable of type Dictionary):
Private Sub EditLibroBtn_Click()
On Error GoTo Err_EditLibroBtn_Click
Dim lngID As Long
Dim ctlCnt As Control
Dim rs As Recordset
lngID = Me.ID
Set GclnAllCnts = New Dictionary
GclnAllCnts.Add Me.Name, Me.RecordsetClone
For Each ctlCnt In Me.Controls
If (ctlCnt.ControlType = acSubform) Then
Set rs = ctlCnt.Form.RecordsetClone
If rs.RecordCount > 0 Then
GclnAllCnts.Add ctlCnt.Name, ctlCnt.Form.RecordsetClone
Else
GclnAllCnts.Add ctlCnt.Name, Null
End If
End If
Next
DoCmd.Close acForm, Me.Name
DoCmd.OpenForm GCstMainFrmName, , , "ID = " & lngID, acFormEdit, acDialog
Exit_EditLibroBtn_Click:
Set ctlCnt = Nothing
Set rs = Nothing
Exit Sub
Err_EditLibroBtn_Click:
MsgBox err.Description & vbNewLine & "Error number: " & err.Number, vbCritical, "Errore"
Resume Exit_EditLibroBtn_Click
End Sub
And this is the code of the close button:
Private Sub ChiudiBtn_Click()
On Error GoTo Err_ChiudiBtn_Click
Dim intBoxAwr As Integer
Dim stSQL As String
Dim vKey As Variant
Dim ctlCnt As Control
Dim clnAllCnts As Dictionary
Dim bSaveNeeded As Boolean
bSaveNeeded = False
If (Me.AllowEdits And Me.ID <> "" And Not IsNull(Me.ID)) Then
Set clnAllCnts = New Dictionary
clnAllCnts.Add Me.Name, Me.RecordsetClone
For Each ctlCnt In Me.Controls
If (ctlCnt.ControlType = acSubform) Then
Set rs = ctlCnt.Form.RecordsetClone
If rs.RecordCount > 0 Then
clnAllCnts.Add ctlCnt.Name, ctlCnt.Form.RecordsetClone
Else
clnAllCnts.Add ctlCnt.Name, Null
End If
End If
Next
If clnAllCnts.Count <> GclnAllCnts.Count Then
bSaveNeeded = True
Else
For Each vKey In clnAllCnts.keys()
If Not GclnAllCnts.Exists(vKey) Then
bSaveNeeded = True
Exit For
Else
'*********** Next Gives error **********
If clnAllCnts.Item(vKey) <> GclnAllCnts.Item(vKey) Then
bSaveNeeded = True
Exit For
End If
End If
Next
End If
If bSaveNeeded Then
intBoxAwr = MsgBox("Salvare le modifiche al libro?", vbYesNo + vbQuestion, "Salvare")
If intBoxAwr = vbYes Then
'etc., omitting code
End Sub
The error I get is Type mismatch (nr. 13) and it is given by the <> comparison (I can Debug.print IsNull(clnAllCnts.Item(vKey)) and IsNull(GclnAllCnts.Item(vKey)).
How can I compare the two recordset variables?
Comparing two Recordset objects by simply saying If rst1 <> rst2 could be dicey anyway, because what does that really mean? Such an expression could very well return True every time, if rst1 and rst2 really are different objects (even if they are of the same object Type).
It appears that you are interested in whether the contents of the two Recordsets is the same. In that case, I would be inclined to serialize the recordset data and store the resulting String instead of storing the Recordset object itself.
The following VBA Function may prove helpful in that case. It loops through a recordset object and produces a JSON-like string containing the current recordset data.
(Note that the function may NOT necessarily produce valid JSON. It doesn't escape non-printing characters like vbCr and vbLf. It doesn't escape backslashes (\). It stores all values as either "string" or null. In other words, in its current form it is not designed to produce a string that could later be deserialized.)
Private Function rstSerialize(ByVal rst As DAO.Recordset)
' loop through the recordset and generate a JSON-like string
' NB: This code will NOT necessarily produce valid JSON!
'
Dim s As String, fld As DAO.Field, rowCount As Long, fldCount As Long
s = "{"
If Not (rst.BOF And rst.EOF) Then
rst.MoveFirst
rowCount = 0
Do Until rst.EOF
If rowCount > 0 Then
s = s & ", "
End If
s = s & """row"": {"
fldCount = 0
For Each fld In rst.Fields
If fldCount > 0 Then
s = s & ", "
End If
s = s & """" & fld.Name & """: " & IIf(IsNull(fld.Value), "null", """" & fld.Value & """")
fldCount = fldCount + 1
Next
s = s & "}"
rowCount = rowCount + 1
rst.MoveNext
Loop
End If
s = s & "}"
rstSerialize = s
End Function
Data Example: If the Recordset contained
DonorID Amount
------- ------
1 10
2 20
the function would return the string
{"row": {"DonorID": "1", "Amount": "10"}, "row": {"DonorID": "2", "Amount": "20"}}
Usage Example: On a form that contains a subform, a button on the main form could do the following
Private Sub Command3_Click()
Dim rst As DAO.Recordset, originalState As String
Set rst = Me.MemberDonationsSubform.Form.RecordsetClone
originalState = rstSerialize(rst)
rst.MoveFirst
rst.Edit
rst!Amount = rst!Amount + 1
rst.Update
Debug.Print "(Recordset updated.)"
If rstSerialize(rst) = originalState Then
Debug.Print "Recordset does not appear to have changed."
Else
Debug.Print "Recordset appears to have changed."
End If
End Sub
which would print the following in the VBA Immediate Window
(Recordset updated.)
Recordset appears to have changed.
I am using DoCmd.TransferSpreadsheet to populate a table. This command is being called using a button on a form. After the transfer is complete I want to tell the user how many records were added. To try and accomplis this I use db.OpenRecordset("select * from tblImport")
then MsgBox(rs.RecordCount)
The problem is that the record count is being called before the transfer is complete. Is there anyway to call this synchronously?
Here is the complete code
Private Sub cmdVIT_Click()
On Error Resume Next
Dim strPath As String
Dim filePicker As FileDialog
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set filePicker = Application.FileDialog(msoFileDialogFilePicker)
With filePicker
.AllowMultiSelect = False
.ButtonName = "Select"
.InitialView = msoFileDialogViewList
.Title = "Select File"
With .Filters
.Clear
.Add "All Files", "*.*"
End With
.FilterIndex = 1
.Show
End With
strPath = filePicker.SelectedItems(1)
Debug.Print strPath
DoCmd.TransferSpreadsheet TransferType:=acImport, SpreadsheetType:=acSpreadsheetTypeExcel12, TableName:="tblImport", FileName:=strPath, HasFieldNames:=True
Set rs = db.OpenRecordset("select * from tblImport")
MsgBox rs.RecordCount & " records"
End Sub
You need an extra line:
Set rs = db.OpenRecordset("select * from tblImport")
'Populate recordset
rs.MoveLast
MsgBox rs.RecordCount & " records"
You want to display the number of rows contained in tblImport. I don't think you need a recordset to give you that information. Try one of these ...
MsgBox CurrentDb.TableDefs("tblImport").RecordCount & " records"
MsgBox DCount("*", "tblImport") & " records"
However if you need or just want to do it with a recordset, use a faster approach for OpenRecordset.
Set rs = db.OpenRecordset("tblImport", dbOpenTable, dbReadOnly)
rs.MoveLast
MsgBox rs.RecordCount & " records"