I have gotten it to wotk:
Code:
Do While Not rS.EOF And HB.EOF
If rS![Row Type] = "FE" Or rS![Equip HB Name] = "." Then
StrVisio = rS![unique_id]
StrPlat = "Soldier"
ElseIf rS![Row Type] = "Plat" Then
StrVisio = rS![Parent Node ID] & "-" & rS![Platform_ID]
StrPlat = rS![Equip HB Name]
End If
If IsNull(rS![Role / FE / Node Name]) Then
StrRole = ";"
Else: StrRole = rS![Role / FE / Node Name]
End If
If IsNull(rS![Bumper # / Plat ID]) Or rS![Bumper # / Plat ID] = "" Then
StrBump = ";;"
Else: StrBump = rS![Bumper # / Plat ID] & ";;"
End If
StrBumpRole = StrRole & " " & StrBump
HB.AddNew
HB![Visio ID] = RTrim([StrVisio])
HB![BN] = rS![Unit]
HB![CO] = rS![TOE Title]
HB![PLT/SEC] = rS![Para Desc]
HB![Role & Bumper #] = Trim(StrBumpRole)
HB![Platform System] = Trim(StrPlat)
HB.Update
rS.MoveNext
Loop
I used this to make the table and columns:
Code:
dbs.Execute "CREATE TABLE Horse_Blanket ([Visio ID] CHAR(25), [BN] CHAR(85), [CO] Char (85), [PLT/SEC] Char(85), [Role & Bumper #] Char(85), [Platform System] Char(95));"
C = 1
For C = C To (Last_Col_Num - 5) 'Adds 40 columns - Equip 1 to Equip 40
DoCmd.RunSQL "ALTER TABLE Horse_Blanket Add " & "[Equip " & C & "] text;"
Next C
The issue I have is when I open the HB table all the data has spaces behind the transferred data. I tried Trim & Rtrim.
Ranman,
I know, but I was trying to get it all VBA
I can use: DoCmd.OpenQuery "qryConversion"\
Code:
SELECT IIf([Row Type]="Plat",[Parent Node ID] & "-" & [Platform_ID],[unique_id]) AS [Visio ID], Data.Unit AS BN, Data.[TOE Title] AS CO, Data.[Para Desc] AS [PLT/SEC], IIf(IsNull([Role / FE / Node Name]),";",[Role / FE / Node Name]) & IIf(IsNull([Bumper # / Plat ID]) Or [Bumper # / Plat ID]="",";;"," " & [Bumper # / Plat ID] & ";;") AS [Role & Bumper#], IIf([Row Type]="FE","Soldier",IIf([Row Type]="Plat",[Equip HB Name])) AS [Platform System] INTO Horse_Blanket
FROM Data
WHERE (((IIf([Row Type]="FE","Soldier",IIf([Row Type]="Plat",[Equip HB Name])))<>"") AND ((Data.[Row Type])<>"TOE" And (Data.[Row Type])<>"PH"));
and
Code:
C = 1
For C = C To (Last_Col_Num - 5) 'Adds 40 columns - Equip 1 to Equip 40
DoCmd.RunSQL "ALTER TABLE Horse_Blanket Add " & "[Equip " & C & "] text;"
Next C