I have been working on a quickbooks project and have been successful on many aspects until I hit a wall at attempting to add a Purchase Order.
as the title states I am using the QBFC -has anyone successfully accomplished this and could point me in the right direction ?
I am currently using mostly example code from the OnScreen reference from quickbooks ( before customizing it) a process which I have used for the other aspects of what I already have working...
It runs fine, but currenrtly doesn't actally add anything to the Quickbooks vendor?
thanks in advance
` Public Sub writePO_ToQB()
Dim sessManager As QBSessionManager
Dim msgSetRs As IMsgSetResponse
sessManager = New QBSessionManagerClass()
Dim msgSetRq As IMsgSetRequest = sessManager.CreateMsgSetRequest("US", 13, 0)
msgSetRq.Attributes.OnError = ENRqOnError.roeContinue
MessageBox.Show("calling write command")
writeActualQBMSG(msgSetRq)
'step3: begin QB session and send the request
sessManager.OpenConnection("App", "DataBridge JBOOKS")
sessManager.BeginSession("", ENOpenMode.omDontCare)
msgSetRs = sessManager.DoRequests(msgSetRq)
End Sub
Public Sub writeActualQBMSG(requestMsgSet As IMsgSetRequest)
' Dim requestMsgSet As IMsgSetRequest
Dim PurchaseOrderAddRq As IPurchaseOrderAdd
PurchaseOrderAddRq = requestMsgSet.AppendPurchaseOrderAddRq()
'add all the elements of a PO to the request - need to determine what is required!!
' PurchaseOrderAddRq.VendorRef.FullName.SetValue("Test Vendor")
PurchaseOrderAddRq.VendorRef.ListID.SetValue("80000094-1512152428")
'------------------- CODE FROM QBS --------
Dim ORInventorySiteORShipToEntityElementType162 As String
ORInventorySiteORShipToEntityElementType162 = "InventorySiteRef"
If (ORInventorySiteORShipToEntityElementType162 = "InventorySiteRef") Then
'Set field value for ListID
PurchaseOrderAddRq.ORInventorySiteORShipToEntity.InventorySiteRef.ListID.SetValue("200000-1011023419")
'Set field value for FullName
PurchaseOrderAddRq.ORInventorySiteORShipToEntity.InventorySiteRef.FullName.SetValue("ab")
End If
If (ORInventorySiteORShipToEntityElementType162 = "ShipToEntityRef") Then
'Set field value for ListID
PurchaseOrderAddRq.ORInventorySiteORShipToEntity.ShipToEntityRef.ListID.SetValue("200000-1011023419")
'Set field value for FullName
PurchaseOrderAddRq.ORInventorySiteORShipToEntity.ShipToEntityRef.FullName.SetValue("ab")
End If
' ----------------- END OF CODE FROM QBS --------------------------------------------
'------------ MOR QBS CODE ------------
Dim ORPurchaseOrderLineAddListElement324 As IORPurchaseOrderLineAdd
ORPurchaseOrderLineAddListElement324 = PurchaseOrderAddRq.ORPurchaseOrderLineAddList.Append()
Dim ORPurchaseOrderLineAddListElementType325 As String
ORPurchaseOrderLineAddListElementType325 = "PurchaseOrderLineAdd"
If (ORPurchaseOrderLineAddListElementType325 = "PurchaseOrderLineAdd") Then
'Set field value for ListID
' ORPurchaseOrderLineAddListElement324.PurchaseOrderLineAdd.ItemRef.ListID.SetValue("200000-1011023419")
'Set field value for FullName
ORPurchaseOrderLineAddListElement324.PurchaseOrderLineAdd.ItemRef.FullName.SetValue("granite")
'Set field value for ManufacturerPartNumber
ORPurchaseOrderLineAddListElement324.PurchaseOrderLineAdd.ManufacturerPartNumber.SetValue("123456789")
'Set field value for Desc
' ORPurchaseOrderLineAddListElement324.PurchaseOrderLineAdd.Desc.SetValue("ab")
'Set field value for Quantity
ORPurchaseOrderLineAddListElement324.PurchaseOrderLineAdd.Quantity.SetValue(2)
Dim DataExt326 As IDataExt
DataExt326 = ORPurchaseOrderLineAddListElement324.PurchaseOrderLineAdd.DataExtList.Append()
'Set field value for OwnerID
' DataExt326.OwnerID.SetValue(System.Guid.NewGuid().ToString())
DataExt326.OwnerID.SetValue(0)
'Set field value for DataExtName
DataExt326.DataExtName.SetValue("ab")
'Set field value for DataExtValue
DataExt326.DataExtValue.SetValue("ab")
End If
If (ORPurchaseOrderLineAddListElementType325 = "PurchaseOrderLineGroupAdd") Then
'Set field value for ListID
ORPurchaseOrderLineAddListElement324.PurchaseOrderLineGroupAdd.ItemGroupRef.ListID.SetValue("200000-1011023419")
'Set field value for FullName
ORPurchaseOrderLineAddListElement324.PurchaseOrderLineGroupAdd.ItemGroupRef.FullName.SetValue("ab")
'Set field value for Quantity
ORPurchaseOrderLineAddListElement324.PurchaseOrderLineGroupAdd.Quantity.SetValue(2)
'Set field value for UnitOfMeasure
ORPurchaseOrderLineAddListElement324.PurchaseOrderLineGroupAdd.UnitOfMeasure.SetValue("ab")
'Set field value for ListID
ORPurchaseOrderLineAddListElement324.PurchaseOrderLineGroupAdd.InventorySiteLocationRef.ListID.SetValue("200000-1011023419")
'Set field value for FullName
ORPurchaseOrderLineAddListElement324.PurchaseOrderLineGroupAdd.InventorySiteLocationRef.FullName.SetValue("ab")
Dim DataExt327 As IDataExt
DataExt327 = ORPurchaseOrderLineAddListElement324.PurchaseOrderLineGroupAdd.DataExtList.Append()
'Set field value for OwnerID
DataExt327.OwnerID.SetValue(System.Guid.NewGuid().ToString())
'Set field value for DataExtName
DataExt327.DataExtName.SetValue("ab")
'Set field value for DataExtValue
DataExt327.DataExtValue.SetValue("ab")
End If
' ----- END OF MORE QBS CODE ----------
End Sub`
The issue here is you have not included the error and response handling code. You need to have something equivalent to the WalkPurchaseOrderAddRs(responseMsgSet). Specifically within that function this checks for error conditions. I have a modified version of their sample.
For j=0 To responseList.Count - 1
Dim response As IResponse
response = responseList.GetAt(i)
'check the status code of the response
If response.StatusCode = 0 Then
' response is ok, handle results as usual...
ElseIf response.StatusCode = 1 Then
' Used when search results return nothing...
Else ' > 1 Is an error
' Is an error or warning condition...
' Capture code and message from QuickBooks
Dim code As String = response.StatusCode
Dim severity As String = response.StatusSeverity ' ERROR or WARNING
Dim message As String = response.StatusMessage
End If
Next j
As a side note, the OSR sample code really is just for illustration purposes. This and similar code is pointless.
Dim ORInventorySiteORShipToEntityElementType162 As String
ORInventorySiteORShipToEntityElementType162 = "InventorySiteRef"
If (ORInventorySiteORShipToEntityElementType162 = "InventorySiteRef") Then
One more hint. When you are setting values from lists like Vendor or ItemRef, you can choose the ListID or the FullName. If you use both as the sample shows then the ListID is used by QuickBooks. I recommend you use the FullName and scrap the ListID. The reason is QuickBooks will parrot whatever you use back to you in an error message. So if your vendor doesn't exist you will either see something like "missing element 80000094-1512152428" or "missing element TheFullName" which is cryptic but readable.
Ok, one more... The sample code that appears to set the custom field data DataExt... will not work. You need to use the DataExtAdd request instead.
Related
Index was out of range. I was trying to put the selected rows in frm_Guest to frm_Main:
Private Sub dgview_GPIGuest_CellContentClick_1(sender As Object, e As
DataGridViewCellEventArgs) Handles dgview_GPIGuest.CellContentClick
Dim ID As String = dgview_GPIGuest.SelectedRows(0).Cells(0).Value.ToString()
Dim FName As String = dgview_GPIGuest.SelectedRows(0).Cells(1).Value.ToString()
Dim LName As String = dgview_GPIGuest.SelectedRows(0).Cells(2).Value.ToString()
Dim Gender As String = dgview_GPIGuest.SelectedRows(0).Cells(3).Value.ToString()
Dim Address As String = dgview_GPIGuest.SelectedRows(0).Cells(4).Value.ToString()
Dim IDType As String = dgview_GPIGuest.SelectedRows(0).Cells(5).Value.ToString()
Dim IDNumber As String = dgview_GPIGuest.SelectedRows(0).Cells(6).Value.ToString()
frm_Main.txt_GPIId.Text = ID
frm_Main.txt_GPIFirstName.Text = FName
frm_Main.txt_GPILastName.Text = LName
frm_Main.txt_GPIAddress.Text = Address
frm_Main.txt_GPIIDNumber.Text = IDNumber
frm_Main.txt_GPIIdType.Text = IDType
If Gender = "Male" Then
frm_Main.rb_GPIMale.Checked = True
Else
frm_Main.rb_GPIFemale.Checked = True
End If
End Sub
I think the confusion is between selected row and cell click. A row is selected by clicking in the far left column of the grid. The entire row will highlight. When a single cell is clicked there are no selected rows; therefore index 0 is out of range. If you want to use this event then use the DataGridViewCellEventArgs as #jmcilhinney suggested.
Debug.Print($"Row {e.RowIndex.ToString}, Column {e.ColumnIndex}")
Firstly, not sure if you already did it but you must set the SelectionMode property to FullRowSelect either in design time or from code behind :
Dgvw1.SelectionMode = DataGridviewSelectionMode.FullRowSelect
The reason for this is to select the entire row when you click on a cell.
Moving on, the usage of SelectedRows is quite unnecessary here(assuming MultiSelect is not set). What i understand so far is that you want to get the column value of the selected row, right ? Here's a quick code :
Dim row = dataGridView1.CurrentCell.RowIndex; ''This gets the row index(or count) of the selected row
Dim col = dataGridView1.CurrentCell.ColumnIndex; ''This gets the column index(or count) of the selected row
Dim ID As String = dataGridView1.Rows(row).Cells(col).Value.ToString()) ''Now note that here i am getting the selected column/cell's value, you can change it with any required index :)
Hope this helps.
The reason you received the error
It's pretty simple to understand. It is somewhat like you are trying to subtract 1 from 0 which will result in -1 but in programming(in cases of collections) , it is an invalid value. I assume when you select a cell, your entire row isn't selected(default behavior)(read the beginning of the answer to fix). That's why SelectedRows(), which is supposed to return all selected rows, returns null. And finally you get the error
I have a Part class with the fields list in the code below. I have a DataGridView control, which I am filtering with the Advanced DGV (ADGV) DLL from NUGET. I must include the ADGV in my winform. I currently have a DataGridView, a search box on the form, and a button to run the following function. I need to go through all of the visible rows, collect a unique list of part numbers with their most recent revisions, and then color the rows in DataGridView which are out of date by checking the part number and rev on each row against the mostuptodate list. For 45,000 entries displayed in DataGridView, this take ~17 secs. For ~50 entries, it take ~1.2 seconds. This is extremely inefficient, but I can't see a way to cut the time down.
Sub highlightOutdatedParts()
'Purpose: use the results in the datagridview control, find the most recent revision of each part, and
' highlight all outdated parts relative to their respective most recent revisions
'SORT BY PART NUMBER AND THEN BY REV
If resultsGrid.ColumnCount = 0 Or resultsGrid.RowCount = 0 Then Exit Sub
Dim stopwatch As New Stopwatch
stopwatch.Start()
resultsGrid.Sort(resultsGrid.Columns("PartNumber"), ListSortDirection.Ascending)
Dim iBag As New ConcurrentBag(Of Part)
Dim sortedList As Generic.List(Of Part)
For Each row As DataGridViewRow In resultsGrid.Rows
If row.Visible = True Then
Dim iPart As New Part()
Try
iPart.Row = row.Cells(0).Value
iPart.Workbook = CStr(row.Cells(1).Value)
iPart.Worksheet = CStr(row.Cells(2).Value)
iPart.Product = CStr(row.Cells(3).Value)
iPart.PartNumber = CStr(row.Cells(4).Value)
iPart.ItemNo = CStr(row.Cells(5).Value)
iPart.Rev = CStr(row.Cells(6).Value)
iPart.Description = CStr(row.Cells(7).Value)
iPart.Units = CStr(row.Cells(8).Value)
iPart.Type = CStr(row.Cells(9).Value)
iPart.PurchCtgy = CStr(row.Cells(10).Value)
iPart.Qty = CDbl(row.Cells(11).Value)
iPart.TtlPerProd = CDbl(row.Cells(12).Value)
iPart.Hierarchy = CStr(row.Cells(13).Value)
iBag.Add(iPart)
Catch ice As InvalidCastException
Catch nre As NullReferenceException
End Try
End If
Next
sortedList = (From c In iBag Order By c.PartNumber, c.Rev).ToList() ' sort and convert to list
Dim mostUTDRevList As New Generic.List(Of Part) ' list of most up to date parts, by Rev letter
For sl As Integer = sortedList.Count - 1 To 0 Step -1 'start at end of list and work to beginning
Dim query = From entry In mostUTDRevList ' check if part number already exists in most up to date list
Where entry.PartNumber = sortedList(sl).PartNumber
Select entry
If query.Count = 0 Then ' if this part does not already exist in the list, add.
mostUTDRevList.Add(sortedList(sl))
End If
Next
'HIGHLIGHT DATAGRIDVIEW ROWS WHERE PART NUMBERS ARE OUT OF DATE
For Each row As DataGridViewRow In resultsGrid.Rows
' if that part with that Rev does not exist in the list, it must be out of date
Try
Dim rowPN As String = CStr(row.Cells(4).Value).ToUpper ' get part number
Dim rowR As String = CStr(row.Cells(6).Value).ToUpper ' get Rev
Dim query = From entry In mostUTDRevList ' check if that part number with that Rev is in the list.
Where entry.PartNumber.ToUpper.Equals(rowPN) AndAlso
entry.Rev.ToUpper.Equals(rowR)
Select entry
If query.Count = 0 Then ' if the part is out of date highlight its' row
row.DefaultCellStyle.BackColor = Color.Chocolate
End If
Catch ex As NullReferenceException
Catch ice As InvalidCastException
End Try
Next
resultsGrid.Select()
stopwatch.Stop()
If Not BackgroundWorker1.IsBusy() Then timertextbox.Text = stopwatch.Elapsed.TotalSeconds.ToString & " secs"
MessageBox.Show("Highlighting completed successfully.")
End Sub
It is almost always faster to work with the data than the control. The control is simply the means to present a view of the data (in a grid) to the users. Working with the data from there requires too much converting to be effieicent. Then, use the DGV events to highlight the rows
Its hard to tell all the details of what you are doing, but it looks like you are comparing the data to itself (as opposed to some concrete table where the lastest revision codes are defined). Nor is it clear why the datasources are collections, ConcurrentBags etc. The key would be to use collections optimized for the job.
To demonstrate, I have a table with 75,000 rows; the product codes are randomly selected from a pool of 25,000 and a revision code is a random integer (1-9). After the DGV datasource is built (a DataTable) a LookUp is created from the ProductCode-Revision pair. This is done once and once only:
' form level declaration
Private PRCodes As ILookup(Of String, Int32)
' go thru table
' group by the product code
' create an anon Name-Value object for each,
' storing the code and highest rev number
' convert result to a LookUp
PRCodes = dtSample.AsEnumerable.
GroupBy(Function(g) g.Item("ProductCode"),
Function(key, values) New With {.Name = key.ToString(), .Value = values.
Max(Of Int32)(Function(j) j.Field(Of Int32)("RevCode"))
}).
ToLookup(Of String, Int32)(Function(k) k.Name, Function(v) v.Value)
Elapsed time via stopwatch: 81 milliseconds to create the collection of 23731 items. The code uses an anonymous type to store a Max Revision code for each product code. A concrete class could also be used. If you're worried about mixed casing, use .ToLowerInvariant() when creating the LookUp (not ToUpper -- see What's Wrong With Turkey?) and again later when looking up the max rev.
Then rather than looping thru the DGV rows use the RowPrePaint event:
If e.RowIndex = -1 Then Return
If dgv1.Rows(e.RowIndex).IsNewRow Then Return
' .ToLowerInvariant() if the casing can vary row to row
Dim pc = dgv1.Rows(e.RowIndex).Cells("ProductCode").Value.ToString()
Dim rv = Convert.ToInt32(dgv1.Rows(e.RowIndex).Cells("RevCode").Value)
Dim item = PRCodes(pc)(0)
If item > rv Then
dgv1.Rows(e.RowIndex).DefaultCellStyle.BackColor = Color.MistyRose
End If
Notes
It takes some time to create the DataSource, but 75,000 rows is a lot to throw at a user
The time to create the LookUp is minimal - barely measurable
There is no noticeable wait in displaying them because a) the LookUp is made for this sort of thing, b) rows are done as needed when they are displayed. Row # 19,999 may never be processed if the user never scrolls that far.
This is all geared to just color a row. If you needed to save the Current/NotCurrent state for each row, add a Boolean column to the DataTable and loop on that. The column can be invisible if to hide it from the user.
The random data results in 47,000 out of date RevCodes. Processing 75k rows in the DataTable to set the flag takes 591 milliseconds. You would want to do this before you set the DataTable as the DataSource to prevent changes to the data resulting in various events in the control.
In general, the time to harvest the max RevCode flag and even tag the out of date rows is a trivial increment to creating the datasource.
The Result:
The data view is sorted by ProductCode so that the coloring of lower RevCodes is apparent.
We surely cant grok all the details and constraints of the system from a small snippet - even the data types and original datasource are a guess for us. However, this should provide some help with better look-up methods, and the concept of working with the data rather than the user's view.
One thing is the revision code - yours is treating them as a string. If this is alphanumeric, it may well not compare correctly - "9" sorts/compares higher than "834" or "1JW".
See also:
Lookup(Of TKey, TElement) Class
Anonymous Types
The solution was spurred in part by #Plutonix.
Sub highlightOutdatedParts()
If resultsGrid.ColumnCount = 0 Or resultsGrid.RowCount = 0 Then Exit Sub
Dim stopwatch As New Stopwatch
stopwatch.Start()
resultsGrid.DataSource.DefaultView.Sort = "PartNumber ASC, Rev DESC"
resultsGrid.Update()
'HIGHLIGHT DATAGRIDVIEW ROWS WHERE PART NUMBERS ARE OUT OF DATE
Dim irow As Long = 0
Do While irow <= resultsGrid.RowCount - 2
' if that part with that Rev does not exist in the list, it must be out of date
Dim utdPN As String = resultsGrid.Rows(irow).Cells(4).Value.ToString().ToUpper()
Dim utdRev As String = resultsGrid.Rows(irow).Cells(6).Value.ToString().ToUpper()
Dim iirow As Long = irow + 1
'If iirow > resultsGrid.RowCount - 1 Then Exit Do
Dim activePN As String = Nothing
Dim activeRev As String = Nothing
Try
activePN = resultsGrid.Rows(iirow).Cells(4).Value.ToString().ToUpper()
activeRev = resultsGrid.Rows(iirow).Cells(6).Value.ToString().ToUpper()
Catch ex As NullReferenceException
End Try
Do While activePN = utdPN
If iirow > resultsGrid.RowCount - 1 Then Exit Do
If activeRev <> utdRev Then
resultsGrid.Rows(iirow).DefaultCellStyle.BackColor = Color.Chocolate
End If
iirow += 1
Try
activePN = resultsGrid.Rows(iirow).Cells(4).Value.ToString().ToUpper()
activeRev = resultsGrid.Rows(iirow).Cells(6).Value.ToString().ToUpper()
Catch nre As NullReferenceException
Catch aoore As ArgumentOutOfRangeException
End Try
Loop
irow = iirow
Loop
resultsGrid.Select()
stopwatch.Stop()
If Not BackgroundWorker1.IsBusy() Then
timertextbox.Text = stopwatch.Elapsed.TotalSeconds.ToString & " secs"
resultcounttextbox.Text = resultsGrid.RowCount - 1 & " results"
End If
MessageBox.Show("Highlighting completed successfully.")
End Sub
I'm writing a macro to read the below Email:
Start Date: July-07-2016
Name Accept Approved
John Yes No
Peter No No
I'm good with search the word "Start date" and get the next 13 character to copy and paste that in a text file. But my problem is the next part is in a Table format. So when I'm searching for the name "John" and trying to copy the next 10 Characters. It doesn't work.
Is there a way to search for the word "Accept" and get the First Row data(Which will be No) and then Second Row data(Which will be No)? Is that possible?
This EMail's table will have only 2 Rows. So, I don't need any dynamic way to get the data. Can someone guide me?
I've tried searching the internet first, but the solutions are too huge for me to understand. Is there any simple way?
I have even tried the solution give here: How to read table pasted in outlook message body using vba? but that method works when the body has ONLY TABLE. But my EMail will have text as well as table.
I've never actually programmed in vba, but I think I can help (a bit) nevertheless.
In the answer on the post you linked to, there is the line
Set msg = ActiveExplorer.Selection.item(1)
I think you can change this to something like
Set msg = Right(ActiveExplorer.Selection.item(1), 25)
to get rid of the text before the table (I got the Right part from here: http://www.exceltrick.com/formulas_macros/vba-substring-function/, but it should also work in Outlook).
This way, you run the code on the table itself instead of on the whole message.If there is also text after the table, it might be more difficult, but you might get that done by searching for the table ending.
I hope this helps!
Attempt 2
After some searching and thinking, I came up with the idea to get the html of the message and use that to parse the table (Ok, not really, I got it from the comments here: http://www.codeproject.com/Questions/567073/Howplustoplusrecognizeplusandplusreadplustableplus). Based on that and other sources, it is possible to write a code that gets the table from an email.
I've written some code that might work, but I couldn't test it as I do not have Outlook. Also, this is my first time writing vba, so there may be a lot of syntax errors (and the code is ugly).
Sub GetTable()
Dim msg As Outlook.mailItem
Dim html As String
Dim tableBegin As String
Dim tableEnd As String
Dim posTableBegin As Long
Dim posTableEnd As Long
Dim table As String
Dim rowBegin As String
Dim rowEnd As String
Dim rowCount As Long
Dim columnBegin As String
Dim columnBeginLen As Long
Dim columnEnd As String
Dim posRowBegin As Long
Dim posRowEnd As Long
Dim values As String(0, 3)
Dim beginValue0 As Long
Dim beginValue1 As Long
Dim beginValue2 As Long
Dim EndValue0 As Long
Dim EndValue1 As Long
Dim EndValue2 As Long
' Get the message and the html
Set msg = ActiveExplorer.Selection.item(1)
html = msg.HTMLbody
' Get the begin and end positions of the table (within the html)
tableBegin = "<table>"
tableEnd = "</table>"
posTableBegin = InStr(1, html, tableBegin)
posTableEnd = InStr(posTableBegin, html, tableEnd)
' Get the html table
table = Mid(html, posTableBegin + Len(tableBegin), posTableEnd - posTableBegin - Len(tableBegin))
' Set the variables for the loop
rowBegin = "<tr>"
rowEnd = "</tr>"
rowCount = 0
columnBegin = "<td>"
columnBeginLen = Len(columnBegin)
columnEnd = "</td>"
' Loop trough all rows
posRowBegin = InStr(lastPos, table, rowBegin)
Do While posRowBegin != 0
' Get the end from the current row
posRowEnd = InStr(posRowBegin, table, rowEnd)
rowCount = rowCount + 1
' Make the array larger
ReDim Preserve values(rowCount + 1, 3)
' Get the contents from that row
row = Mid(table, posRowBegin + Len(rowBegin), posRowEnd - posRowBegin - Len(rowBegin))
' Get the three values from that row (name, Accept, Approved) and put it in the array
beginValue0 = InStr(1, row, columnBegin) + columnBeginLen
endValue0 = InStr(beginValue0, row, columnEnd)
beginValue1 = InStr(endValue0, row, columnBegin) + columnBeginLen
endValue1 = InStr(beginValue1, row, columnEnd)
beginValue2 = InStr(endValue1, row, columnBegin) + columnBeginLen
endValue2 = InStr(beginValue2, row, columnEnd)
values(rowCount, 0) = Mid(row, beginValue0, endValue0)
values(rowCount, 1) = Mid(row, beginValue1, endValue1)
values(rowCount, 2) = Mid(row, beginValue2, endValue2)
' Get the beginning of the next row
posRowBegin = InStr(lastPos, table, rowBegin)
Loop
' The values are now in the (double) array 'values'.
' values(0, [1-3]) contains the headers.
End Sub
As said before, the original idea came from http://www.codeproject.com/Questions/567073/Howplustoplusrecognizeplusandplusreadplustableplus. Additionally, I used Word VBA how to select text between two substrings and assign to variable? and the Microsoft documentation to write this.
While it is likely that the code does not work out of the box, I think it still gets the general idea (and some specifics) across, so that it can be used as a guide. I hope this is the solution you need!
You can actually use the Word Object Model to parse out the text from the table - assuming that the email is in HTML format.
Get a Word.Document object from the Inspector.WordEditor property and use Word objects and methods to get the text, like the following below example from MSDN. Just replace ActiveDocument with the variable you declare and set from WordEditor.
Sub ReturnCellContentsToArray()
Dim intCells As Integer
Dim celTable As Cell
Dim strCells() As String
Dim intCount As Integer
Dim rngText As Range
If ActiveDocument.Tables.Count >= 1 Then
With ActiveDocument.Tables(1).Range
intCells = .Cells.Count
ReDim strCells(intCells)
intCount = 1
For Each celTable In .Cells
Set rngText = celTable.Range
rngText.MoveEnd Unit:=wdCharacter, Count:=-1
strCells(intCount) = rngText
intCount = intCount + 1
Next celTable
End With
End If
End Sub
My problem:
When trying to Set Table = cSheet.Range(brand_edit) (brand_edit is a variable with the value of a table name) I get Run-time error '1004': Method 'Range' of object '_WorkSheet' failed.
I think it is because I am trying to find the range of a variable's value and I can't think of a way to fix this.
More Info:
I am making a userform that allows the user to grab an Item ID from a Data Sheet in excel and fill a table/item list with the data from the row the Item ID leads.
I have setup a combobox that grabs my table of contents (the Brands) from the Data Sheet (I made it into a table and used the table as the RowSource). I then setup another combobox that displays the Item ID's from the selected Brand. When you select a particular ID I am trying to get it to grab the data from the row in the table that that Item ID leads.
Each Brand has a table tied to it I use some funky replacing to get it to match the table naming scheme. I use these tables as flexible ranges (these tables will change over time so I need to account for that). The item ID's lead the rows and each row has information about the item (cost, description, etc.)
If there are better ways to do any of these things, I am open to ideas.
These are some questions I viewed to try to solve this:
This one introduced me to the code for this and I tried factoring to my use case and I got errors.
Excel VBA - select, get and set data in Table
Public brand_edit As String
Private Sub cmbItemID_Change()
Dim cBook As Workbook
Dim cSheet As Worksheet
Dim ItemID As String
Dim Brand_Table As String
Dim test As String
Dim i As Long
Dim Table As ListObject
Set cBook = ActiveWorkbook
Set cSheet = cBook.Sheets("Gen. Info")
ItemID = cmbItemID.Value
Brand_Table = brand_edit
MsgBox Brand_Table
Set Table = cSheet.Range(brand_edit).Select
For i = 1 To Table.ListRows.Count
If Table.ListColumns(1).DataBodyRange.Rows(i) = ItemID Then
MsgBox ItemID
End If
Next
MsgBox test
End Sub
Public Sub cmbItemID_DropButtonClick()
'funky replacing
Dim brand As String
brand = cmbBrand.Value
brand_edit = Replace(brand, " ", "_")
brand_edit = Replace(brand_edit, """", "")
brand_edit = Replace(brand_edit, "-", "")
brand_edit = Replace(brand_edit, "__", "_")
brand_edit = LCase(brand_edit)
cmbItemID.RowSource = brand_edit
End Sub
There is a better way to Synchronize ComboBoxes! No coding!
Both ComboBoxes have the same dataSetting settings. They set the same value in the shared LinkedCell.
1. BoundColumn
2. LinkedCell
3. ListFillRange
But we change their display setting to give the user a different view.
1. ColumnCount
2. ColumnWidths
3. ListRows
4. ListWidth
You can not directly set a the ListFillRange to a Table. The workaround is to create a Define a Name and set the ListFillRange the new name.
ListFillRange -> Products -> Table1
So I fixed the problem. What was causing it was I was referencing the wrong sheet (aka Gen. Info). How I fixed it was this:
Set dSheet = cBook.Sheets("DATA")
Set Table = dSheet.Range(brand_edit)
Of course once one problem is fixed another one appears. So I am currently working to fix that one.
This post after reading it a number of times (a few last night before posting this and then a couple times this morning) I finnaly got what it was saying and helped me fix this problem. VBA method 'range of object' _Worksheet failed suddenly coming up when running code?
Hopefully this is more useful.
Place getRowSource in a public module. It'll be easier to test and expand.
Public Function getRowSource(brand As String) As String
brand = Replace(brand, " ", "_")
brand = Replace(brand, """", "")
brand = Replace(brand, "-", "")
brand = Replace(brand, "__", "_")
brand = LCase(brand)
getRowSource = brand
End Function
In this way, you can test your rowsource logic in the Immediate Window
If cmbItemID's RowSource is the table that you want to reference then cmbItemID' s ListIndex is it the row that you want to reference.
Dim itemIndex As Long, brand_edit As String
brand_edit = getRowSource(cmbBrand.Value)
itemIndex = cmbItemID.ListIndex
With cSheet.ListObjects(brand_edit)
TextBoxListPrice.Value = DataBodyRange(itemIndex, 1)
TextBoxListCost.Value = DataBodyRange(itemIndex, 2)
TextBoxNotes.Value = DataBodyRange(itemIndex, 3)
TextBoxSpecs.Value = DataBodyRange(itemIndex, 4)
TextBoxDescription.Value = DataBodyRange(itemIndex, 5)
End With
Self teaching VB beginner here.
I have a data entry section that includes...
2 comboboxes(cbx_TruckType, cbx_DoorNumber)
-------cbx_TruckType having 2 options (Inbound, Outbound)
-------cbx_DoorNumber having 3 options (Door 1, Door 2, Door 3)
2 textboxes (txb_CustomerName, txb_OrderNumber)
-------txb_CustomerName will hold a customer name
-------txb_OrderNumber will hold an order number
and finally...
a button(btn_EnterTruck) that transfers the text from the comboxes and textboxes to the following...
2 Tabs
The 1st tab has
2 buttons(btn_Door1, btn_Door2)
btn_Door1 has 3 corresponding textboxes
-------txb_TruckTypeDoor1, txb_CustomerNameDoor1, txb_OrderNumberDoor1
btn_Door2 has 3 corresponding textboxes
-------txb_TruckTypeDoor2, txb_CustomerNameDoor2, txb_OrderNumberDoor2
The 2nd tab has
1 button(btn_Door3)
btn_Door1 has 3 corresponding textboxes
-------txb_TruckTypeDoor3, txb_CustomerNameDoor3, txb_OrderNumberDoor3
Currently, I have code (that works thanks to another question I had!) that, upon btn_EnterTruck.click, will transfer the text to the corresponding textboxes.
Here's my problem...
I've coded a msgbox to pop-up (when Inbound is selected from the cbx_TruckType) asking if there is an Outbound. If I click "Yes", an inputbox pops-up and asks for an order number. The button then transfers the Inbound information to the textboxes and stores the Outbound order number.
When I click btn_Door1(or 2 or 3), it clears the text from its corresponding textboxes. (Using me.controls)
( I would add code for all of the above, but I figure its a moot point, because it works)
What I want to happen...
I want to have the stored Outbound number to be saved with a reference to which door number it corresponds to. Then upon btn_DoorX click, it will fill that order number into the corresponding textbox. I don't need the text stored/saved when the app is closed.
And I have no idea how to do that.
*After some tooling, I've done the following, but it does not work"
I declared these at the class level.
Dim str_SameTruckPODoor1, str_SameTruckPODoor2, str_SameTruckPODoor3 As String
This code is in the btn_EnterTruck event
Dim str_ErrOutDoorName As String = cbx_DoorNumber.Text
Dim str_OutboundDoorName As String = str_ErrOutDoorName.Replace(" ", "")
Dim ArrayForPONumbers As Control() = Me.Controls.Find("str_SameTruckPO" & str_OutboundDoorName, True)
If cbx_TruckType.Text = "Inbound" Then
Dim OutboundMsg = "Is there an Outbound with this truck information?"
Dim Title = "Outbound?"
Dim style = MsgBoxStyle.YesNo Or MsgBoxStyle.DefaultButton2 Or _
MsgBoxStyle.Question
Dim response = MsgBox(OutboundMsg, style, Title)
If response = MsgBoxResult.Yes Then
Dim NeedPOMessage, NeedPOTitle, defaultValue As String
Dim PONumberOutbound As String
' Set prompt.
NeedPOMessage = "Enter the PO Number"
' Set title.
NeedPOTitle = "PO# For Outbound"
defaultValue = "?" ' Set default value.
' Display message, title, and default value.
PONumberOutbound = InputBox(NeedPOMessage, NeedPOTitle, defaultValue)
' If user has clicked Cancel, set myValue to defaultValue
If PONumberOutbound Is "" Then PONumberOutbound = defaultValue
ArrayForPONumbers(0) = PONumberOutbound
End If
End If
I'm getting an error message on
ArrayForPONumbers(0) = PONumberOutbound ' Cannot convert string to .controls
And I have the following code in the btn_Door1 event - it handles btn_Door2, btn_Door3
Dim WhichButton As Button = CType(sender, Button)
Dim str_ErrDoorName As String = WhichButton.Name
Dim str_DoorName As String = str_ErrDoorName.Replace("btn_", "")
Dim str_DoorType As Control() = Me.Controls.Find("txb_" & str_DoorName & "Type", True)
Dim str_Customer As Control() = Me.Controls.Find("txb_" & str_DoorName & "Customer", True)
Dim str_OrderNumber As Control() = Me.Controls.Find("txb_" & str_DoorName & "OrderNumber", True)
Dim SecondArrayForPONumbers As Control() = Me.Controls.Find("str_SameTruckPO" & str_DoorName, True)
If str_DoorType(0).Text = "Outbound" Then
str_DoorType(0).Text = ""
str_Customer(0).Text = ""
str_OrderNumber(0).Text = ""
ElseIf SecondArrayForPONumbers(0).Text.Length > 0 Then
str_DoorType(0).Text = "Outbound"
str_OrderNumber(0).Text = Me.Controls("str_SameTruckPO" & str_DoorName).Text
End If
Any help is appreciated. If I'm not clear on what I'm asking or haven't given enough details, please let me know.
Edit: Added info based on comment, Added code, Changed Title
How long do you want this data to be stored? IE: longer than the life of the open application? If the application is closed is it alright if the data is lost? If not, you may want to consider writing this data to an external database.