Hi guys i am new here and i am new to vba.
i want to solve the following problem:
i have two different access tables. each of them contains data i want to compare first and then, if a certain constraint is true i want to import certain columns out of one of the two access db tables into an excel sheet.
what i already have: the connection to the databases, i can read the data and print them on the console via debug.print command.
i have really no idea how to write certain rows (those which conform to the constraint) to the excel sheet.
Code sample
'commandstring and data base variables stands here
'non database connection variables
Dim oldID, newID, oldBuildPlanned, newBuildPlanned As String
Dim createExcel, doesExcelExist As Boolean
Dim xl As Excel.Application
Dim wb As Excel.Workbook
Dim Wksht As Excel.Worksheet
Dim dataVar As String
Dim counter As Integer
counter = 0
createExcelSheet = False
doesSheetExist = False
'Debug.Print "TEST old database"
Do While Not objRs.EOF And Not objRs2.EOF
'Debug.Print vbTab & objRs(0) & " " & objRs(1)
'assigning database values to variables to make them comparable
oldID = objRs(counter)
newID = CStr(objRs2(counter))
oldBuildPlanned = objRs(counter + 1)
newBuildPlanned = objRs2(counter + 1)
If oldID = newID And oldBuildPlanned = newBuildPlanned Then
createExcel = True
If createExcelSheet = True And Not doesSheetExist = True Then
Set xl = New Excel.Application
Set wb = xl.Workbooks.Add
Set Wksht = ActiveWorkbook.Worksheets("Sheet1")
doesExcelExist = True
End If
Call writeReport(newID)
End If
objRs.MoveNext
objRs2.MoveNext
Loop
'tidy up stuff comes here
end of code
I am sorry if my code is not formatted as its usual, its my first post in this forum ^^
So the writeReport() should contain the code to write the data into the sheet. i planned to insert the id's of the matching database entries into the method as parameters and read these certain data out of the recordset. but i cannot convert recordset items to string, so the byRef parameter declaration causes a compile error "type mismatch". In addition i tried to export the table with DoCmd.TransferSpreadsheet, but this method exports the entire table into excel, it worked, but it is not what i am searching for.
i hope someone can help me with my little low level problem, if you need further information feel free to ask me. i am using ADO.
Thanks in advance
Welcome to the forum,
I think you might find these two websites helpful for what you are trying to do. The first one is a great tutorial on using Access and Excel together.
http://www.datawright.com.au/excel_resources/excel_access_and_ado.htm
http://www.w3schools.com/sql/default.asp
I am not sure how you are creating your recordset, by I would recommend using an SQL statement as your source. That way you only pull the data from Access that you need. If you have any more specific questions, please let me know.
Jason
Related
New to VBA, I am successfully importing and reading a Task List and Resources from Excel, executing VBA in Excel and inserting these records into MS Project. I am looking at setting the ActiveProject.Resources.Standardrate = "100p/h", however I am getting an error.
The code being applied (credit to previous answers provided to other related questions on Stackoverflow for the following code).
If Not ExistsInCollection (newproject.Resources, strResource) Then
newproject.resources.add.name = StrResource <-- This works, resources are added.
' However, inserting the following line:
newproject.resources.standardrate = "100p/h" <-- It errors here
End if
Any assistance is greatly appreciated - Thank you.
The code needed a minor modification to get a reference to the newly-added resource so that the StandardRate can then be updated.
This code also demonstrates how to handle the case of a list of comma-delimited resources rather than a single one.
Dim t As Task
Set t = NewProject.Tasks.Add("New task 1")
Dim StrResource As String
StrResource = "Resource 1,Resource 2,Resource 3"
Dim arrRes As Variant
arrRes = Split(StrResource, ",")
Dim i As Variant
For Each i In arrRes
If Not ExistsInCollection(NewProject.Resources, i) Then
Dim r As Resource
Set r = NewProject.Resources.Add(i)
r.StandardRate = 100
End If
t.Assignments.Add , ActiveProject.Resources(i).UniqueID
Next i
I haven't been able to find a question that is close enough to what i need or maybe i'm not as good as googling as I thought I was.
Anyway I have an issue where I need to use excel as a database as my place of work doesn't have access.
The way in which this is supposed to work is that in the 'ui' workbook after the user has inputed the data required it needs to take the users employee number from the 'ui' workbook and use that to find them in a list of all employees on the 'database' worksheet then increase a field that indicates that they have completed this specific task one more time. Then on a different sheet also on the second workbook it needs to record the date completed and also input the users id against this date.
so far I haven't attempted the code for the second part as I am having trouble with the first. Here is what i have so gotten to so far and it errors at the match function
Sub SendToDB()
Application.ScreenUpdating = False
Dim DB As Workbook
Dim UI As Workbook
Dim ENo As Long
Dim CopyFrom As Worksheet
Set CopyFrom = Worksheets("Checklist")
ENo = Range("G45").Value
Set UI = ThisWorkbook
Set DB = Workbooks.Open("file location here\database.xlsx", True)
Dim EmCount As Long
Dim EmRow As Long
Dim EmCell As Range
Application.ScreenUpdating = False
DB.Worksheets("EMLIST").Activate
EmRow = Application.WorksheetFunction.Match(ENo, Range("AML"), 0)
EmCell = Range("G" & EmRow)
EmCount = Application.WorksheetFunction.VLookup(EmENo, Range("AML"), 7, False)
EmCount = EmCount + 1
EmCell.Value = EmCount
DB.Close True
Set DB = Nothing
Application.ScreenUpdating = True
End Sub
AML is a named range on the database spreadsheet which contains all the employee data
Thanks
Excel now has the possibility to store personal filtering views to help collaboration in simultaniously used documents.
I could only find Microsoft documentation for an add-in, but the function is available in my Excel version of MS Excel for Microsoft 365 MSO (16.0.13127.20266) 32bit.
https://learn.microsoft.com/en-us/javascript/api/excel/excel.namedsheetview?view=excel-js-preview
I am trying to store the currently applied NamedSheetView name property (for later restoring option) but
this code fails:
Dim sh1 As Worksheet
Dim xViewName As String
Set sh1 = ThisWorkbook.Sheets(Sheet6.Name)
xViewName = sh1.NamedSheetView.Name
However this code works (with previously created "Test" view):
sh1.NamedSheetViews.GetItem("Test").Activate
If this NamedSheetViews is a collection, I should be able to get the item property, but these codes also fail:
strName = sh1.NamedSheetViews.GetItem(1).Name
strName = sh1.NamedSheetViews.Item(1).Name
Anyone has ever succeeded in getting the current NamedSheetView of a Worksheet?
Here is how I probe unknown Object properties:
I start with a reference to the Object. If I don't know what the Object is I use TypeName() to return it's class name (data type). I then declare a variable of that data type. Wash, rinse and repeat as I drill down the structure. Once the variable is declared, selecting the variable and pressing F1 with open the Microsoft Help document for that data type.
Module Code
Sub WhatIsThat()
Const TestName As String = "TestName"
Dim View As NamedSheetViewCollection
Set View = Sheet6.NamedSheetViews
On Error Resume Next
View.GetItem(TestName).Delete
On Error GoTo 0
View.Add TestName
Dim SheetView As NamedSheetView
Dim n As Long
For n = 0 To View.Count - 1
Debug.Print View.GetItemAt(n).Name
Set SheetView = View.GetItemAt(n)
Debug.Print SheetView.Name
Next
Stop
End Sub
Immediate Window Tests
?TypeName(Sheet6.NamedSheetViews)
?View.GetItemAt(0).Name
?TypeName( View.GetItemAt(0))
SOLUTION:
(Thanks for the great help from TinMan)
Dim SheetView As NamedSheetView
Dim sh1 As Worksheet
Dim ActiveSheetView as string
Set sh1 = ThisWorkbook.Sheets(Sheet6.Name)
Set SheetView = sh1.NamedSheetViews.GetActive
ActiveSheetView = SheetView.Name
Application:
sh1.NamedSheetViews.GetItem(ActiveSheetView).Activate
I have a problem with my below code which freezes and does nothing while running.
INFRASTRUCTURE:
Visual Studio 2017
.NET Framework 4.7.2
OS: Windows 7
GOAL:
I have a DataGridView which has 3 columns, I'm listing some information in this DataGridView from another source to fill first and second row.
The first row is the parameter name and the second one is this parameter's current value.
The third column is not filling in this process, I will fill that 3rd column from my database Excel file to compare the parameter's current value with the database value stored in Excel. This is where my problems start.
I'm trying to use below code for filling DataGridView parameter value from Excel sheet which I'm using a database;
Some parameters not stored in an Excel sheet so in fact, I need a function like vlookup to map data with the parameter name.
In excel A column is my parameter name and B column is the parameter's database value.
I'm trying to import this excel and trying to match parameter names in DataGridView and Excel if the parameter name is same it should writing Excel parameter value to a 3rd column in DataGridView.
Public Class BuildImportExcel
Public Shared Sub NewMethod(ByVal dgv As DataGridView)
Dim ofd As OpenFileDialog = New OpenFileDialog With {
.Filter = "Excel |*.xlsx",
.Title = "Import Excel File"
}
ofd.ShowDialog()
Try
If ofd.FileName IsNot "" Then
Dim xlApp As New Excel.Application
If xlApp Is Nothing Then
MessageBox.Show("Excel is not properly installed!")
Else
Dim xlBook As Excel.Workbook = xlApp.Workbooks.Open(ofd.FileName)
Dim xlSheet As Excel.Worksheet = CType(xlBook.ActiveSheet, Excel.Worksheet)
For i = 0 To dgv.Rows.Count
If dgv.Rows(i).Cells(0).Value IsNot "" Then
Dim look As Boolean = True
Dim found As Boolean = False
Dim rowLook As Integer = 2
Dim rowFound As Integer = 0
While look = True
If xlSheet.Range("A" & rowLook).Value IsNot "" Then
If xlSheet.Range("A" & rowLook).Text Is dgv.Rows(i).Cells(0).Value Then
found = True
rowFound = rowLook
End If
Else
look = False
End If
rowLook = rowLook + 1
End While
If found = True Then
dgv.Rows(i).Cells(2).Value = xlSheet.Range("B" & rowFound).Text
End If
End If
Next
xlApp.Quit()
Release(xlSheet)
Release(xlBook)
Release(xlApp)
End If
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
Private Shared Sub Release(ByVal sender As Object)
Try
If sender IsNot Nothing Then
Marshal.ReleaseComObject(sender)
sender = Nothing
End If
Catch ex As Exception
sender = Nothing
End Try
End Sub
End Class
But the problem is it's not working freezing I thought parameter list about 200 rows so it causes to freezing and try it with small portions like 5 parameters and still same. Seems something wrong and I couldn't find it.
Also is it logic way to match them with that method or do you suggest anything like OLEDB connection?
EDIT:
I turn off Option Strict and then change IsNot to operator <> and then it start to work but i'd like to use Option Strict On how can i handle this operators?
You are making this more difficult than it has to be. A questionable and problematic area is the While look = True loop. This assumes a lot and, in my test, will cause the code to freeze often. The main problem here is that the code is (somewhat) looping through the rows from the Excel file. The issue here is that you do not KNOW how may rows there are! There is no checking for this and the code will fail on the line…
If xlSheet.Range("A" & rowLook).Value IsNot "" Then
When you reach the bottom of the given Excel file and it never finds a match.
Another issue is the line…
If xlSheet.Range("A" & rowLook).Text Is dgv.Rows(i).Cells(0).Value Then
This is ALWAYS going to fail and will never be true. My understanding…
The Is operator determines if two object references refer to the same
object. However, it does not perform value comparisons.
Given this, I recommend you simplify things a bit. Most important are the loops through the Excel worksheet which is “expensive” and if there is a lot of rows, you may have a performance problem. When I say a lot of rows, I mean tens of thousands of rows…. 200 rows should be fine.
It would un-complicate things if we could tell how many rows from the worksheet are returned from….
Dim xlSheet As Excel.Worksheet = CType(xlBook.ActiveSheet, Excel.Worksheet)
This is basically an Excel Range, and it is from this Range that we can get the number of rows in this excel range with…
Dim totalExcelRows = xlSheet.UsedRange.Rows.Count
Now, instead of the complicated and problematic While loop, we can replace it with a simple for loop. This will eliminate some variables and will keep the loop index in row range in the excel file.
I hope this makes sense… below is an example of what is described above.
Public Shared Sub NewMethod(ByVal dgv As DataGridView)
Dim ofd As OpenFileDialog = New OpenFileDialog With {
.Filter = "Excel |*.xlsx",
.Title = "Import Excel File",
.InitialDirectory = "D:\\Test\\ExcelFiles"
}
ofd.ShowDialog()
Try
If ofd.FileName IsNot "" Then
Dim xlApp As New Excel.Application
If xlApp Is Nothing Then
MessageBox.Show("Excel is not properly installed!")
Else
Dim xlBook As Excel.Workbook = xlApp.Workbooks.Open(ofd.FileName)
Dim xlSheet As Excel.Worksheet = CType(xlBook.ActiveSheet, Excel.Worksheet)
Dim totalExcelRows = xlSheet.UsedRange.Rows.Count
For i = 0 To dgv.Rows.Count
If dgv.Rows(i).Cells(0).Value IsNot Nothing Then
For excelRow = 1 To totalExcelRows
If xlSheet.Range("A" & excelRow).Text.ToString() = dgv.Rows(i).Cells(0).Value.ToString() Then
dgv.Rows(i).Cells(2).Value = xlSheet.Range("B" & excelRow).Text
Exit For
End If
Next
Else
Exit For
End If
Next
xlApp.Quit()
Marshal.ReleaseComObject(xlSheet)
Marshal.ReleaseComObject(xlBook)
Marshal.ReleaseComObject(xlApp)
End If
End If
Catch ex As Exception
MsgBox(ex.Message)
End Try
End Sub
I have a button in Access (2003) that transfers data to Excel (also 2003). It opens the Excel workbook, then cycles through the Access subforms and transfers data.
To give more information on how this works, Excel has a range called "Tables" which contains the names of the Access subforms ("Main", "Demographics", "History", etc). Excel also has a range for each of the names in that first range. For example, the range "Demographics" contains a series of field names ("FirstName", "LastName", etc). So the first loop moves through the subforms, and the nested loop moves through the field names. Each field then passes the value in it over to excel. Excel also has ranges for "Demographics_Anchor" and "History_Anchor" etc, which is the first value in the column next to each range (ie the range Demographics has firstname, lastname, and to the right is where the data would go. So the first item in the range is FirstName, to the right "Demographics_Anchor" is where firstname will go. Then LastName goes to Demographics_Anchor offset by 1 - or 1 cell down from the anchor).
Dim ThisForm As Form
Dim CForm As Object
Dim CTab As TabControl
Dim CControl As Control
Dim CurrentTab As Variant
Dim CControlName As Variant
Dim CControlValue As String
Dim Code As Control
Dim counter1 As Integer
Dim appExcel As Object
Dim Anchor As Object
Dim PageRange As Object
Dim ControlNameRange As Object
strpath = "C:\blah\blah\filename.xlsm"
Set appExcel = CreateObject("Excel.Application")
appExcel.Workbooks.Open Filename:=strpath, UpdateLinks:=1, ReadOnly:=True
Set wbk = appExcel.ActiveWorkbook
Set PageRange = appExcel.Range("Tables")
'set Access environment
Set ThisForm = Forms("frmHome")
Set CTab = ThisForm.Controls("Subforms")
'export the data from Access Forms to Excel
For Each CurrentTab In PageRange
If CurrentTab = "Main" Then
Set CForm = ThisForm
Else
CTab.Pages(CurrentTab).SetFocus
Set CForm = ThisForm.Controls(CurrentTab & " Subform").Form
End If
Set ControlNameRange = appExcel.Range(CurrentTab)
Set Anchor = appExcel.Range(CurrentTab & "_Anchor")
counter1 = 0
For Each CControlName In ControlNameRange
Set CControl = CForm.Controls(CControlName)
CControl.SetFocus
Anchor.Offset(RowOffset:=counter1).Value = CControl.Value
counter1 = counter1 + 1
Next CControlName
Next CurrentTab
I hope this explains what is going on in the code. I just can't figure out why this keeps bombing out with type mistmatch (error 13).
The data DOES transfer. It goes through the entire code and every piece of data correctly gets transferred over. It bombs out at the end as if it goes through the code 1 last time when it shouldn't. I did confirm that every range is correct and doesn't contain any null values. The code bombs out on this line: Set CControl = CForm.Controls(CControlName) which is towards the bottom of the second loop.
Please help! I've spent weeks working with this code and had no luck. This exact code works in every other database I've worked with.
You are getting the name of the control CControlName from your Excel Range, but then setting the value of this control to the control on the Access form Set CControl = CForm.Controls(CControlName). From this, the most likely explanation is probably that the CControlName isn't actually on the Access form (perhaps a typo?).
In the VBA IDE, go under the Tools Menu, select Options and then select the General tab. Under the Error Trapping section, select the "Break on All Errors" option and click "OK" to set the preference. Run your code again; when an error is encountered VBA will stop processing on the line that caused the error. Check the value of CControlName and make sure it actually exists on the Access form.