By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
462,049 Members | 693 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 462,049 IT Pros & Developers. It's quick & easy.

VBA to Populate Table (Update)

P: 52
This question is an extension to that in VBA to populate access table.

I have been looking for a way to expand it to update the block attributes after modifying the TableDef but with no success.
What I am trying to do is, after populating the Attribute Table, run an update query, then send the updated TableDef back to the attributes. I am not sure how to pull it back and then loop it through in order to update the attribute blocks

I really appreciate any help that can be provided. I have been searching and working at this for days.
Expand|Select|Wrap|Line Numbers
  1. Sub Export_Access_Attributes() 'Written by Neopa
  2.  
  3. ' Open database and delete old records if exist
  4. ' ---------------------------------------------
  5.     Dim dbs As DAO.Database
  6.     Dim dbsName As String
  7.     Dim activeDoc As AcadDocument
  8.     Dim DocLength As Integer
  9.     Dim Shortlength As Integer
  10.     Dim DwgPath As String
  11.     Dim DwgName As String
  12.     Dim DocName As String
  13.     Dim data As DAO.Recordset
  14.     Dim TableDef As String
  15.  
  16.     Dim Attribs  As Variant     'Defaults to Variant
  17.     Dim Handle As String
  18.     Dim blockName As String
  19.     Dim tag As String
  20.     Dim Loops As String
  21.     Dim Address As String
  22.     Dim Label1 As String
  23.     Dim Label2 As String
  24.     Dim Device_Label As String
  25.     Dim Extended_Label As String
  26.     Dim Qty As String
  27.     Dim Model_Num As String
  28.     Dim Description As String
  29.     Dim Vendor As String
  30.     Dim CSFM_Num As String
  31.  
  32.     Dim ssnew As Object
  33.     Dim setObj As Object
  34.     Dim setColl As AcadSelectionSets
  35.     Dim Entity As AcadEntity
  36.     Dim blkEntity As AcadBlockReference
  37.     Dim i As Variant        'Defaults to Variant
  38.  
  39. ' Strip off extension .dwg
  40. ' -------------------------------
  41.     Set activeDoc = ThisDrawing.Application.ActiveDocument
  42.     DocName = activeDoc.Name
  43.     DocLength = Len(DocName)
  44.  
  45.     Shortlength = DocLength - 4
  46.     DwgPath = activeDoc.Path
  47.     DwgName = Left(DocName, Shortlength)
  48.  
  49.     dbsName = "Project_Drawings.mdb"
  50.     Set dbs = DBEngine.OpenDatabase(DwgPath & "\" & dbsName)   'Path to be C:\Blocks Folder
  51.  
  52. ' Open recordset in table
  53. ' -----------------------
  54.  
  55. ' Determine Tables Def
  56. ' --------------------------
  57.     TableDef = "Attribute Report1"
  58.     Set data = dbs.OpenRecordset(TableDef, dbOpenDynaset)
  59.  
  60. ' Clear old values from table
  61. ' ---------------------------
  62.     dbs.Execute "DELETE * FROM [Attribute Report1]", dbFailOnError
  63.  
  64. ' Make Selection set of Blocks
  65. ' ----------------------------
  66.    ThisDrawing.ActiveSpace = acModelSpace
  67.     With activeDoc
  68.         Set setColl = .SelectionSets
  69.         For Each setObj In .SelectionSets
  70.             If setObj.Name = "VBA" Then
  71.                 .SelectionSets.Item("VBA").Delete
  72.                 Exit For
  73.             End If
  74.         Next
  75.         Set ssnew = activeDoc.SelectionSets.Add("VBA")
  76.     End With
  77.     ssnew.Select acSelectionSetAll
  78.  
  79. ' Get Attribute values
  80. ' ---------------------
  81.     For Each Entity In ssnew
  82.  
  83.        If Entity.ObjectName = "AcDbBlockReference" Then
  84.        Set blkEntity = Entity
  85.  
  86.        If blkEntity.HasAttributes Then
  87.         Attribs = blkEntity.GetAttributes
  88.  
  89.         For i = LBound(Attribs) To UBound(Attribs)
  90.  
  91.             Select Case Attribs(i).TagString
  92.  
  93.             Case "HANDLE"
  94.                 Handle = Attribs(i).TextString
  95.             Case "BLOCKNAME"
  96.                 blockName = Attribs(i).TextString
  97.             Case "TAG"
  98.                 tag = Attribs(i).TextString
  99.             Case "LOOP"
  100.                 Loops = Attribs(i).TextString
  101.             Case "ADDRESS"
  102.                 Address = Attribs(i).TextString
  103.             Case "LABEL1"
  104.                 Label1 = Attribs(i).TextString
  105.             Case "LABEL2"
  106.                 Label2 = Attribs(i).TextString
  107.             Case "DEVICE_LABEL"
  108.                 Device_Label = Attribs(i).TextString
  109.             Case "EXTENDED_LABEL"
  110.                 Extended_Label = Attribs(i).TextString
  111.             Case "QTY"
  112.                 Qty = Attribs(i).TextString
  113.             Case "MODEL_NUM"
  114.                 Model_Num = Attribs(i).TextString
  115.             Case "DESCRIPTION"
  116.                 Description = Attribs(i).TextString
  117.             Case "VENDOR"
  118.                 Vendor = Attribs(i).TextString
  119.             Case "CSFM_NUM"
  120.                 CSFM_Num = Attribs(i).TextString
  121.  
  122.             End Select
  123.  
  124.         Next i
  125.  
  126. ' Fill Database Table-----------------
  127.             If Handle = "" Then Handle = " "
  128.             If blockName = "" Then blockName = " "
  129.             If tag = "" Then tag = " "
  130.             If Loops = "" Then Loops = " "
  131.             If Address = "" Then Address = " "
  132.             If Label1 = "" Then Label1 = " "
  133.             If Label2 = "" Then Label2 = " "
  134.             If Device_Label = "" Then Device_Label = " "
  135.             If Extended_Label = "" Then Extended_Label = " "
  136.             If Qty = "" Then Qty = " "
  137.             If Model_Num = "" Then Model_Num = " "
  138.             If Description = "" Then Description = " "
  139.             If Vendor = "" Then Vendor = " "
  140.             If CSFM_Num = "" Then CSFM_Num = " "
  141.  
  142.             data.AddNew
  143.             data!Handle = "'" & Entity.Handle
  144.             data!blockName = blockName
  145.             data!tag = tag
  146.             data!Address = Address
  147.             data!Label1 = Label1
  148.             data!Label2 = Label2
  149.             data!Device_Label = Device_Label
  150.             data!Extended_Label = Extended_Label
  151.             data!Qty = Qty
  152.             data!Model_Num = Model_Num
  153.             data!Description = Description
  154.             data!Vendor = Vendor
  155.             data!CSFM_Num = CSFM_Num
  156.             data.Update
  157.  
  158.         End If
  159.         End If
  160.  
  161.      Next Entity
  162.  
  163. '************************************************************
  164. '   'HERE is where the code to pull updated table from access goes…
  165. ''    Attribs(0).TextString = "THIS IS THE NEW NEW VALUE!"
  166. '
  167. '    ' Get the attributes again
  168. '    Dim newAttribs As Variant
  169. '    newAttribs = blkEntity.GetAttributes
  170. '
  171. '    ' Again, display the tags and values
  172. '    strAttributes = ""
  173. '    For i = LBound(Attribs) To UBound(Attribs)
  174. '        strAttributes = strAttributes + "  Tag: " + _
  175. '        newAttribs(i).TagString + vbCrLf + _
  176. '        "   Value: " + newAttribs(i).TextString
  177. '************************************************************
  178.  
  179. ' Close Database
  180. ' --------------
  181.     data.Close
  182.     dbs.Close
  183.     Set data = Nothing
  184.     Set dbs = Nothing
  185.     ssnew.Delete
  186. End Sub
Jun 5 '16 #1
Share this Question
Share on Google+
3 Replies

NeoPa
Expert Mod 15k+
P: 31,770
Hi Tim.

This doesn't seem trivial so I'll get to look at it when I have a little more time on my hands.

I left a link into here from the other thread though, so anyone seeing that will know to come through if interested.
Jun 5 '16 #2

NeoPa
Expert Mod 15k+
P: 31,770
I'm sorry to say that I have nothing further to add at this point.

I've gone through the code and there's far too much involved logic there that simply isn't explained. You either need to explain things much much better, which I know is beyond most people to do, or get some paid help with someone who has the time to spend on a single project like this.

A last option would be to break it down into a manageable chunk. You have all your code in there and loads of references to items which are probably not fundamental to your problem. If you can chop out the dead wood and explain your problem precisely and clearly then you might get some takers.

I'm afraid that as it is though, it's way way out of bounds for a question in here.

That's not to say you might not get lucky and find someone interested to help, but I wouldn't advise relying on that too heavily.
Jun 6 '16 #3

P: 52
Ok well I thank you anyways...

Ultimately what I am looking for is how to Dim the updated table back into VBA and then how to update the Attribute Block values.

In Excel I believe it is something like...
Dim vAttributeData
vAttributeData = XlSheet.UsedRange
But I don't know how to pull a table

Then once it is dimmed, how to match it up for use.
I think I need to match the "Handle" row in the table to the "Handle in the Attribute Block and when a match is found then update the .textstring.

I am playing around with the following, but I am still off track...

Expand|Select|Wrap|Line Numbers
  1. ' Get Attribute values
  2.  For Each Entity In ssnew
  3.  
  4.  If Entity.ObjectName = "AcDbBlockReference" Then
  5.    Set blkEntity = Entity
  6.  
  7.  If blkEntity.HasAttributes Then
  8.    Dim newAttribs As Variant
  9.  
  10.    newAttribs = blkEntity.GetAttributes
  11.  
  12. For n = LBound(newAttribs) To UBound(newAttribs)
  13.  
  14. Select Case newAttribs(n).TagString
  15. Case "HANDLE"
  16.  Handle = newAttribs(n).TextString
  17. Case "BLOCKNAME"
  18.  blockName = newAttribs(n).TextString
  19. Case "TAG"
  20.  tag = newAttribs(n).TextString
  21. Case "LOOP"
  22.  Loops = newAttribs(n).TextString
  23. Case "ADDRESS"
  24.  Address = newAttribs(n).TextString
  25. Case "LABEL1"
  26. Label1 = newAttribs(n).TextString
  27. Case "LABEL2"
  28.  Label2 = newAttribs(n).TextString
  29. Case "DEVICE_LABEL"
  30.  Device_Label = newAttribs(n).TextString
  31. Case "EXTENDED_LABEL"
  32.  Extended_Label = newAttribs(n).TextString
  33. Case "QTY"
  34.  Qty = newAttribs(n).TextString
  35. Case "MODEL_NUM"
  36.  Model_Num = newAttribs(n).TextString
  37. Case "DESCRIPTION"
  38.  Description = newAttribs(n).TextString
  39. Case "VENDOR"
  40.  Vendor = newAttribs(n).TextString
  41. Case "CSFM_NUM"
  42.  CSFM_Num = newAttribs(n).TextString
  43.  
  44.  End Select
  45.  Next n
  46.  'Entity(n).Update 'This line does not work
  47.  End If
  48.  End If
  49.  Next Entity
  50.  
  51.  
Jun 7 '16 #4

Post your reply

Sign in to post your reply or Sign up for a free account.