Basically, I want to extract one column from access base on my query in VBA.
My sample code are below, No error were found but the only thing that is working is it just open the excel file were the data from access should be copied.
'Set db = OpenDatabase("\\location\names.mdb")
Set rs = db.OpenRecordset("select first_name from customerinfo " _
& "where datehired between #" & (DTPicker1) & "# and #" & (DTPicker2) & "# ;")
If rs.RecordCount <> 0 Then
Dim x As Integer
Dim count As Integer
Dim PATH, file As String
PATH =("\\location\Extracted Data.xlsm")
file = Right$(PATH, Len(PATH) - InStrRev(PATH, "\"))
Workbooks.Open PATH
Workbooks(file).Activate
count = rs.RecordCount
For x = 2 To count
Workbooks(file).Sheets("extracted").Range("a" & x) = rs.Fields("first_name")
Next
End If'
I should have 3 result to be copied in my excel. can someone help me find what seems to be missing in my code? :(
For one, you're using .RecordCount before fully loading the recordset on a dynaset. That probably returns 1, since only 1 record has been loaded yet, making your code skip over For x = 2 To count (since that's for x=2 to 1)
Secondly, you're not actually moving the recordset.
A somewhat better approach (barring other errors I might've missed):
x = 2
Do While Not rs.EOF 'While not at the end of the recordset
Workbooks(file).Sheets("extracted").Range("a" & x) = rs.Fields("first_name")
x = x + 1
rs.MoveNext 'Move to next record
Loop
Related
I am trying to clean up some existing code
Sheets("Control").Select
MyDir = Cells(2, 1)
CopySheet = Cells(6, 2)
MyFileName = Dir(MyDir & "wp*.xls")
' when the loop breaks, we know that any subsequent call to Dir implies
' that the file need to be added to the list
While MyFileName <> LastFileName
MyFileName = Dir
Wend
MyFileName = Dir
While MyFileName <> ""
Cells(LastRow + 1, 1) = MyFileName
LastRow = LastRow + 1
MyFileName = Dir
Wend
My question relates to how Dir returns results and if there are any guarantees on the order of results. When using Dir in a loop as above, the code implies that the resultant calls to Dir are ordered by name.
Unless Dir guarantees this, it's a bug which needs to be fixed. The question, does Dir() make any guarantee on the order in which files are returned or is it implicit?
Solution
Based on #Frederic's answer, this is the solution I came up with.
Using this quicksort algorithm in conjunction and a function that returns all files in a folder ...
Dim allFiles As Variant
allFiles = GetFileList(MyDir & "wp*.xls")
If IsArray(allFiles) Then
Call QuickSort(allFiles, LBound(allFiles), UBound(allFiles))
End If
Dim x As Integer
Dim lstFile As String
x = 1
' still need to loop through results to get lastFile
While lstFile <> LastFileName
lstFile = allFiles(x)
x = x + 1
Wend
For i = x To UBound(allFiles)
MyFileName = allFiles(i)
Cells(LastRow + 1, 1) = MyFileName
LastRow = LastRow + 1
Next i
There's no guarantee that Dir() will return the files in any particular order. The MS Access VBA documentation even says:
Tip Because file names are
retrieved in no particular order, you
may want to store returned file names
in an array, and then
sort the array.
I know this post is old but I share the solution I have found for those who are also looking for a short solution.
I write all the filenames in a Excel sheet column and I use a variable which will get the name of the files. Then I run a loop to open each file based on the name retrieved by the variable according to the order they have written in the column.
For Row_Value = 1 To 10
NameFile= Range("N" & Row_Value).Value 'NameFile = "Worbook1"
MyFile = Dir("C\Desktop\Folder1\" & NameFile & ".xlsm")
Next Row_Value
I hope it's clear.
I am writing VBA to save an Excel file.
Sub savethisshit()
filepath = "C:\Users\***\****\***\AR\***\***by Customer\"
yr = Year(Date)
m = Month(Date) - 1
fac = Left(Sheets(2).Name, 3)
If fac = "EF " Then
fac = "EF"
Else
fac = fac
End If
If m < 10 Then
mth = "0" & m
Else
mth = m
End If
file = filepath & yr & "." & mth & " " & fac & " Vol by Customer.xlsx"
ActiveWorkbook().SaveAs file
End Sub
Whenever I try to execute this subroutine, it works, until ActiveWorkbook().SaveAs file. I get a debug error. However, if I run the macro through debug, it works. I only get the error when I try to execute the macro.
There are two problems.
The file extension disturbance by the period
And the current document is a document containing macros, but the storage target is a problem of warning due to a general Excel document.
I think it can be solved with the syntax Application.DisplayAlerts = False.
This warning message appears in the following cases: Two or more cells contain values, merge the cells, delete a sheet when there is a value on a sheet, etc. In your case, there is a period in the middle of the file name, and after that, it is recognized as a file extension, but a warning window pops up because it is different from the file format. If the macro-created document is saved as a general document, a warning window appears because the format does not match. However, this is something that gives the user a choice, not absolute. This can be used to let the user ignore the popping up of the warning window. You can use it for smooth progress of the program.
Sub savethisshit()
Dim filepath As String
Dim yr As Integer, m As Integer
Dim fac As String
Dim Ws As Workbook
Dim file As String, mth As String
filepath = "C:\Users\***\****\***\AR\***\***by Customer\"
'filepath = ThisWorkbook.Path & "\"
yr = Year(Date)
m = Month(Date) - 1
fac = Left(Sheets(2).Name, 3)
If fac = "EF " Then
fac = "EF"
End If
mth = Format(m, "0#")
file = filepath & yr & "." & mth & " " & fac & " Vol by Customer.xlsx"
Application.DisplayAlerts = False
Set Ws = ActiveWorkbook
Ws.SaveAs Filename:=file, FileFormat:=xlOpenXMLWorkbook
Application.DisplayAlerts = True
End Sub
I'm trying to import relevant information from Excel report which is not specifically designed to import data. Basically it is formatted report with other information. Please see the attached image to get an idea. This is huge report and contains hundreds of rows.
I'm thinking to import data by reading Excel file reading line by line, based on the information on that particular row and then inserting that row into Access table.
I've attached simplified version of report to give you an idea about the report layout and also Access table structure, the information I want to store in table DailyTranaction.
Example Report Image here:
Access Table Structure Image here:
I'm not sure the best way to do the above task using Access VBA, a working simple example will be highly appreciated.
Insert new code module then copy and paste below code:
Option Compare Database
Option Explicit
Public Function GetDataFromReport(ByVal sRepFileName As String) As Integer
Dim xlApp As Object, xlWbk As Object, xlWsh As Object
Dim retVal As Integer, sRepDate As String, r As Integer, sBranch As String, sQry As String, rs As Integer
On Error GoTo Err_GetDataFromReport
DoCmd.SetWarnings False
Set xlApp = CreateObject("Excel.Application")
Set xlWbk = xlApp.Workbooks.Open(sRepFileName)
Set xlWsh = xlWbk.Worksheets(1) 'or pass the name, ex: "Sheet1"
sRepDate = xlWsh.Range("A1")
r = InStr(1, sRepDate, "th")
sRepDate = Replace(sRepDate, Left(sRepDate, InStr(r - 3, sRepDate, " ")), "")
sRepDate = Replace(sRepDate, "th", "")
'find the last row;
rs = xlWsh.Range("A" & xlWsh.Rows.Count).End(-4162).Row
r = 3
Do While r <= rs
Select Case UCase(Trim(xlWsh.Range("A" & r)))
Case "", UCase("CustId")
'skip empty row and header of data
GoTo SkipRow
Case UCase("Branch:")
sBranch = xlWsh.Range("B" & r)
Case Else
'proceed if the value is numeric
If Not IsNumeric(xlWsh.Range("A" & r)) Then GoTo SkipRow
sQry = "INSERT INTO Reports([ReportDate],[BranchCode],[CustId],[AccountNo],[Transaction])" & vbCr & _
"VALUES(#" & sRepDate & "#," & sBranch & ", " & xlWsh.Range("A" & r) & _
", " & xlWsh.Range("B" & r) & ", " & xlWsh.Range("C" & r) & ")"
'Debug.Print sQry
DoCmd.RunSQL sQry
'get the number of rows affected ;)
retVal = retVal +1
End Select
SkipRow:
r = r + 1
Loop
Exit_GetDataFromReport:
On Error Resume Next
DoCmd.SetWarnings True
Set xlWsh = Nothing
xlWbk.Close SaveChanges:=False
Set xlWbk = Nothing
xlApp.Quit
Set xlApp = Nothing
'return value
GetDataFromReport = retVal
Exit Function
Err_GetDataFromReport:
MsgBox Err.Description, vbExclamation, Err.Number
Resume Exit_GetDataFromReport
End Function
To use this, you need to create macro, which action should refer to above function:
GetDataFromReport ("C:\report.xls")
As you can see, you need to define full path to the source workbook.
Alternativelly, you can run above code by creating procedure:
Sub Test()
MsgBox GetDataFromReport("D:\Report Daily Transaction.xls") & " records have been imported!", vbInformation, "Message..."
End Sub
Alternativelly, you can create macro which open form. Sample database and report
Good luck!
I am trying to clean up some existing code
Sheets("Control").Select
MyDir = Cells(2, 1)
CopySheet = Cells(6, 2)
MyFileName = Dir(MyDir & "wp*.xls")
' when the loop breaks, we know that any subsequent call to Dir implies
' that the file need to be added to the list
While MyFileName <> LastFileName
MyFileName = Dir
Wend
MyFileName = Dir
While MyFileName <> ""
Cells(LastRow + 1, 1) = MyFileName
LastRow = LastRow + 1
MyFileName = Dir
Wend
My question relates to how Dir returns results and if there are any guarantees on the order of results. When using Dir in a loop as above, the code implies that the resultant calls to Dir are ordered by name.
Unless Dir guarantees this, it's a bug which needs to be fixed. The question, does Dir() make any guarantee on the order in which files are returned or is it implicit?
Solution
Based on #Frederic's answer, this is the solution I came up with.
Using this quicksort algorithm in conjunction and a function that returns all files in a folder ...
Dim allFiles As Variant
allFiles = GetFileList(MyDir & "wp*.xls")
If IsArray(allFiles) Then
Call QuickSort(allFiles, LBound(allFiles), UBound(allFiles))
End If
Dim x As Integer
Dim lstFile As String
x = 1
' still need to loop through results to get lastFile
While lstFile <> LastFileName
lstFile = allFiles(x)
x = x + 1
Wend
For i = x To UBound(allFiles)
MyFileName = allFiles(i)
Cells(LastRow + 1, 1) = MyFileName
LastRow = LastRow + 1
Next i
There's no guarantee that Dir() will return the files in any particular order. The MS Access VBA documentation even says:
Tip Because file names are
retrieved in no particular order, you
may want to store returned file names
in an array, and then
sort the array.
I know this post is old but I share the solution I have found for those who are also looking for a short solution.
I write all the filenames in a Excel sheet column and I use a variable which will get the name of the files. Then I run a loop to open each file based on the name retrieved by the variable according to the order they have written in the column.
For Row_Value = 1 To 10
NameFile= Range("N" & Row_Value).Value 'NameFile = "Worbook1"
MyFile = Dir("C\Desktop\Folder1\" & NameFile & ".xlsm")
Next Row_Value
I hope it's clear.
Was wondering if there is an easy to convert structured files into YAML data fixtures for Doctrine / Symfony.
I don't see any utility with Doctrine to accept CSV.
I might just start writing something simple to do this. Is it worthwhile?
I wrote my own Macro to solve this problem & shared it. You can specify the fields in your model, fill-out the data and the YAML is generated.
The best part is that it supports Nested Data as well (based on NestedSet Doctrine Behaviour)
You can download the file from here:
http://www.prasadgupte.com/go/converting-csvexcel-data-to-doctrine-yaml-fixtures/
Hope this helps!
A quick google search came up with this: http://code.activestate.com/recipes/546518-simple-conversion-of-excel-files-into-csv-and-yaml/
Requires Python though but that shouldn't be a problem. Looks quite promising and does exactly what you need (keeping in mind that CSV files can be opened with excel like a native excel file and saved as .xls)
If you are already using the conversion macro, then you can add a function that will create a PHP script from the CSV data. So a data row for the object "Pen" like:
name type price
Pen Name, Type, Price
"Reyballs Super Point 0.5", "Ball point", 10
"Palkar Ink Pen", "Ink Pen", 25
would output:
// Object: Pen
$pen1 = new Pen();
$pen1->name = "Reyballs Super Point 0.5";
$pen1->type = "Ball point";
$pen1->price = "10";
$pen1->save();
unset($pen1);
$pen2 = new Pen();
$pen2->name = "Palkar Ink Pen";
$pen2->type = "Ink Pen";
$pen2->price = "25";
$pen2->save();
unset($pen2);
Here is the macro function:
Sub GeneratePHP()
targetSheetRow = 1
fieldNamesRow = 3
sourceSheetDataRow = fieldNamesRow + 1
earlyLoopEnd = False
counter = 0
' do not run without active sheet
If ActiveSheet.Name = "" Then
MsgBox "Please call the macro from a sheet"
End
End If
' identify sheets
Set source = ActiveSheet
' custom output sheet
targetSheetName = source.Cells(1, 12)
If targetSheetName = "" Or targetSheetName = "Output" Then
targetSheetName = "Output"
Else
On Error GoTo RTE
Set Target = Worksheets(targetSheetName)
GoTo RTS
RTE:
'MsgBox "PG" & Err.Description, Title:=Err.Source
targetSheetName = "Output"
End If
RTS:
' clear exsiting data in Target/Output sheet
Set Target = Worksheets(targetSheetName)
Target.Cells.Clear
Target.Cells.Font.Name = "Courier"
' Get no of fields in model (assume level & key always there)
noOfCols = 2
Do While source.Cells(fieldNamesRow, noOfCols + 1) <> "end"
noOfCols = noOfCols + 1
Loop
' If no field other than level & key, error
If noOfCols < 3 Then
MsgBox "No data for the records"
End
End If
' print Model name
Target.Cells(targetSheetRow, 1) = "// Object: " + source.Cells(1, 4)
targetSheetRow = targetSheetRow + 1
objClass = source.Cells(1, 4)
' Loop over data rows in source sheet
Do While source.Cells(sourceSheetDataRow, 1) <> "end"
If source.Cells(sourceSheetDataRow, 1) = "end-loop" Then
Target.Cells(targetSheetRow, 1) = "<?php endfor; ?>"
targetSheetRow = targetSheetRow + 1
earlyLoopEnd = True
GoTo NextRow
End If
' rows to skip
If source.Cells(sourceSheetDataRow, 2) = "~!~" Or source.Cells(sourceSheetDataRow, 1) = "~!~" Then
GoTo NextRow
End If
' read level
blanks = source.Cells(sourceSheetDataRow, 1)
' print key
counter = counter + 1
varName = "$" + LCase(objClass) + CStr(counter)
varDec = varName + " = new " + objClass + "();"
Target.Cells(targetSheetRow, 1) = varDec
targetSheetRow = targetSheetRow + 1
spaces = spaces + " "
spaces_count = spaces_count + 2
' print fields when value != ~!~
For clNumber = 3 To noOfCols
If CStr(source.Cells(sourceSheetDataRow, clNumber)) <> "~!~" And CStr(source.Cells(fieldNamesRow, clNumber)) <> "~!~" Then
Target.Cells(targetSheetRow, 1) = varName + "->" + source.Cells(fieldNamesRow, clNumber) + " = """ + CStr(source.Cells(sourceSheetDataRow, clNumber)) + """;"
targetSheetRow = targetSheetRow + 1
End If
Next clNumber
Target.Cells(targetSheetRow, 1) = varName + "->save();"
targetSheetRow = targetSheetRow + 1
Target.Cells(targetSheetRow, 1) = "unset(" + varName + ");"
targetSheetRow = targetSheetRow + 1
NextRow:
' go for next row in source sheet
sourceSheetDataRow = sourceSheetDataRow + 1
Loop
' Success
msg = "Data from sheet """ & source.Name & """ was converted to YAML on """ & targetSheetName & """ sheet" & vbCrLf & vbCrLf & "prasadgupte.com"
MsgBox msg
' Focus on output sheet
Sheets(targetSheetName).Select
Range("A1:A" & (targetSheetRow - 1)).Select
End Sub
You can try Data Transformer (disclaimer - I'm its developer). It converts between CSV, JSON, XML, and YML locally.
It has many conversion settings (with good defaults) so you can tailor the result for your purposes.
You can get it from the Mac App Store or the Microsoft Store.
There's not trial version, but you can ask Apple or Microsoft for a refund if it doesn't work for you!