Dim counter
Dim columnArray
Dim rsItemDB
Dim itemName, align, itemLevel, itemAV, itemSavSpell, itemSavBreath, itemSavPar, itemDam
Dim itemHit, itemArmorAdj, itemHP, itemMP, itemMoves, itemStr, itemDex, itemCon, itemSavMent
Dim itemInt, itemWis, itemCha, itemMat, itemWt, itemSpcFlag, itemSpcAff, itemLoc
Dim itemDictionary
Set myFSO = CreateObject("Scripting.FileSystemObject")
Set rsData = CreateObject("ADODB.Recordset")
Set oConn = CreateObject("ADODB.Connection")
Set oConn2 = CreateObject("ADODB.Connection")
set itemDictionary = CreateObject("Scripting.Dictionary")
addItemDictionary
itemDictionary.CompareMode = BinaryCompare
filePath = "E:\Games\Carrionfields"
fileName = "carritems.txt"
itemCSVDB = "itemList.csv"
With oConn
.Provider = "Microsoft.Jet.OLEDB.4.0;"
.Properties ("Extended Properties").Value = "text;HDR=No;FMT=Delimited"""
.Open filePath
End With
With oConn2
.Provider = "Microsoft.Jet.OLEDB.4.0;"
.Properties ("Extended Properties").Value = "text;HDR=Yes;FMT=Delimited"""
.Open filePath
End With
matArray = array("cloth", "stone", "onyx", "energy", "silver", "gold", "iron", "brass", "flesh", "gem",_
"wood", "glass", "obsidian", "moonstone", "leather", "coral", "adamantite")
Set rsData = oConn.Execute("SELECT * FROM " & fileName)
counter = 0
While Not rsData.EOF
updateValues 'sub which sets all variable fields to blank
m = 0 'used as a boolean for a blank line
For each field in rsData.Fields
If isNull(field) = False Then 'skips processing the field if there's nothing in it
If field = rsData(0) Then 'parses the description field for item name, align flag, and item level
If InStr(field, "+"& [G,E,N]) <> 0 Then
align = "[" & Trim(Mid(field, InStrRev(field, "+")-1, InStrRev(field, " ") - InStrRev(field, "+")+1)) & "]"
itemName = Replace(Trim(Left(field, InStrRev(field, "+")-1)), "'", "")
itemLevel = Trim(Right(field, Len(field) - InStrRev(field, " ")))
ElseIf InStr(field, "-" & [G,E,N]) <> 0 Then
align = "[" & Trim(Mid(field, InStrRev(field, "-")-1, Len(field) - InStrRev(field," ")+1)) & "]"
itemName = Replace(Trim(Left(field, InStrRev(field, "-")-1)), "'", "")
itemLevel = Trim(Right(field, Len(field) - InStrRev(field, " ")))
Else
itemName = Replace(Trim(Left(field, InStrRev(field, " "))), "'", "")
itemLevel = Trim(Right(field, Len(field) - InStrRev(field, " ")))
End If
End If
If field = rsData(1) Then
RegExpTest field 'tests for non-alpha characters, sets itemAV if none are present
End If
If InStr(field, "w") <> 0 And field <> rsData(0)Then
RegExpTest field 'tests for field leading with "w" and then looking for numbers
End If
If InStr(LCase(field), "special:") <> 0 Then
itemSpcAff = Trim(Replace(field, "'", ""))
Else
tempItem = LCase(Trim(Left(field, InStrRev(field, " "))))
tempItem = Replace(tempItem, "'", "")
parseItems(tempItem)
End If
m=1 'boolean for non-blank field, if not set, blank rows returned
End If
next
'need argument for \dd\d (avg damage)
'need argument for good, neut, evil flag
'need to account for tab delimited
'successfully parse 'identify' output
updateValues2 'sets variables to current values
If m = 1 Then
oConn2.Execute rsItemDB
End If
counter = counter + 1
rsData.movenext
Wend
oConn.Close
oConn2.Close
MsgBox "Inventory Parsing Complete"
Sub updateValues
itemName = ""
align = ""
itemLevel = ""
itemAV = ""
itemSavSpell = ""
itemSavBreath = ""
itemSavPar = ""
itemSavMent = ""
itemDam = ""
itemHit = ""
itemArmorAdj = ""
itemHP = ""
itemMP = ""
itemMoves = ""
itemStr = ""
itemDex = ""
itemCon = ""
itemInt = ""
itemWis = ""
itemCha = ""
itemMat = ""
itemWt = ""
itemSpcFlag = ""
itemSpcAff = ""
itemLoc = ""
End Sub
Sub updateValues2
rsItemDB = "INSERT INTO " &_
itemCSVDB &_
" VALUES ('" &_
itemName & "', '" &_
align & "', '" &_
itemLevel & "', '" &_
itemAV & "', '" &_
itemSavSpell & "', '" &_
itemSavBreath & "', '" &_
itemSavPar & "', '" &_
itemSavMent & "', '" &_
itemDam & "', '" &_
itemHit & "', '" &_
itemArmorAdj & "', '" &_
itemHP & "', '" &_
itemMP & "', '" &_
itemMoves & "', '" &_
itemStr & "', '" &_
itemDex & "', '" &_
itemCon & "', '" &_
itemInt & "', '" &_
itemWis & "', '" &_
itemCha & "', '" &_
itemMat & "', '" &_
itemWt & "', '" &_
itemSpcFlag & "', '" &_
itemSpcAff & "', '" &_
itemLoc & "')"
End Sub
Sub addItemDictionary
With itemDictionary
.Add "dam", 1
.Add "hit", 2
.Add "hp", 3
.Add "spar", 4
.Add "sbreath", 5
.Add "sspell", 6
.Add "arm", 7
.Add "mana", 8
.Add "str", 9
.Add "dex", 10
.Add "con", 11
.Add "int", 12
.Add "wis", 13
.Add "cha", 14
.Add "moves", 15
.Add "smental", 16
End With
End Sub
Sub parseItems(n)
Select Case itemDictionary.Item(n)
Case 1: itemDam = field
Case 2: itemHit = field
Case 3: itemHP = field
Case 4: itemSavPar = field
Case 5: itemSavBreath = field
Case 6: itemSavSpell = field
Case 7: itemArmorAdj = field
Case 8: itemMP = field
Case 9: itemStr = field
Case 10: itemDex = field
Case 11: itemCon = field
Case 12: itemInt = field
Case 13: itemWis = field
Case 14: itemCha = field
Case 15: itemMoves = field
Case 16: itemSavMent = field
Case Else:
For x=0 to UBound(matArray)
If field = matArray(x) Then
itemMat = field
End If
next
End Select
End Sub
'code borrowed and modified from Microsoft website
Sub RegExpTest(str)
Set objRegEx = New RegExp
'find all matches
objRegEx.Global = True
objRegEx.IgnoreCase = True
objRegEx.Pattern = "[^a-z]"
'create the collection of matches
Set Matches = objRegEx.Execute(str)
'print out all matches
For Each Match in Matches
strReturnStr = strReturnStr & Match.value
Next
If Len(field) = Len(strReturnStr) Then
itemAV = field
End If
'determines if field is the "item weight" field
If field <> itemAV And InStr(field, "w") <> 0 Then
objRegEx.Global = False
str = Trim(LCase(str))
objRegEx.Pattern = "[w\d\.]"
Set Matches = objRegEx.Execute(str)
For Each Match in Matches
strReturnStr = strReturnStr & Match.value
Next
If Len(Trim(field)) = Len(strReturnStr) Then
itemWt = field
End If
End If
End Sub