Advertisement
Guest User

BeanCounter Export

a guest
Aug 18th, 2016
130
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VBScript 25.00 KB | None | 0 0
  1. ' Coded by bwh
  2. ' copyright, left, strafe!
  3. ' http://wow.curse.com/downloads/wow-addons/details/beancounter-export.aspx
  4. Option Base 1
  5.  
  6. ' constants to setup which column each data should appear. there is no logic check involved, so be careful not to give duplicate column numbers!
  7. Const ASStatus = 1
  8. Const ASCharName = 2
  9. Const ASFaction = 3
  10. Const ASItemName = 4
  11. Const ASCount = 5
  12. Const ASBid = 6
  13. Const ASBidPer = 7
  14. Const ASBuyout = 8
  15. Const ASBuyoutPer = 9
  16. Const ASDeposit = 10
  17. Const ASDepositPer = 11
  18. Const ASDay = 12
  19. Const ASMonth = 13
  20. Const ASYear = 14
  21. Const ASBuyer = 15
  22. Const ASFee = 16
  23. Const ASFeePer = 17
  24. Const ASNetGain = 18
  25. Const ASReason = 16
  26. Const ASItemID = 19
  27. Const AFItemID = 15
  28. Const MBuyoutItemID = 17
  29. Const MBidItemID = 17
  30. Dim quit As Boolean
  31.  
  32. Private Sub lolFileOpen()
  33.     quit = False
  34.     Dim fd As FileDialog
  35.     Set fd = Application.FileDialog(msoFileDialogOpen)
  36.    
  37.     With fd
  38.         .AllowMultiSelect = False
  39.         .InitialFileName = "C:\Program Files\World of Warcraft\"
  40.         .Title = "full path to BeanCounter.lua? should be something like ...\WoW\WTF\Account\xxx\SavedVariables\BeanCounter.lua"
  41.         .Filters.clear
  42.         .Filters.Add "LUA files", "*.lua"
  43.  
  44.         If .Show = -1 Then
  45.             If .SelectedItems.Count > 0 Then
  46.                 inputFile = .SelectedItems.Item(1)
  47.                 Sheets("settings").Cells(1, 2).Value = inputFile
  48.             Else
  49.                 MsgBox "File dialog did not show!", vbCritical, "Warning"
  50.                 quit = True
  51.                 Exit Sub
  52.             End If
  53.         Else
  54.             MsgBox "No input file specified!", vbCritical, "Warning"
  55.             quit = True
  56.             Exit Sub
  57.         End If
  58.     End With
  59. End Sub
  60.  
  61.  
  62. Private Sub ReadFile()
  63.  
  64. 'Debug.Print Now
  65. Application.EnableCancelKey = xlDisabled
  66.  
  67.     Call Clearing
  68.     Dim fullpath As String
  69.     Dim inputFile As String
  70.     Dim fileContents As String
  71.     Dim ServerName As String
  72.     Dim procAS As Boolean, procAF As Boolean, procMBO As Boolean, blnAutoFilter As Boolean, procMBid As Boolean, blnCurrencyFormat As Boolean
  73.     Dim myRegExp As RegExp, myRegExp2 As RegExp
  74.     Dim myMatches As MatchCollection, myItems As MatchCollection
  75.     Dim myMatch As Match, myItem As Match
  76.     Dim mxas As Double, mxaf As Double, mxmb As Double
  77.     Dim arrItemIDs() As String
  78.     Dim arrAS()
  79.     Dim arrAF()
  80.     Dim arrMB()
  81.     Dim arrMBid()
  82.  
  83.    
  84.     If Sheets("settings").Cells(1, 2).Value = "Enter full filename of BeanCounter.lua or click Browse" Then
  85.         Call lolFileOpen
  86.         If quit Then Exit Sub
  87.     End If
  88.     inputFile = Trim(Sheets("settings").Cells(1, 2).Value)
  89. ' inputFile = InputBox("full path to BeanCounter.lua? should be something like ...\WoW\WTF\Account\xxx\SavedVariables\BeanCounter.lua", "BeanCounter.lua full path?")
  90. ' inputFile = "c:\Documents and Settings\bwh\Desktop\BeanCounter.lua"
  91.    UseDuration = False
  92.     ServerName = Sheets("settings").Cells(2, 2).Value
  93.     CharacterName = Sheets("settings").Cells(3, 2).Value
  94.     Duration = Sheets("settings").Cells(4, 2).Value
  95.     If Duration > 0 Then UseDuration = True
  96.     If Sheets("settings").Cells(5, 2).Value = "Process" Then procAS = True
  97.     If Sheets("settings").Cells(6, 2).Value = "Process" Then procAF = True
  98.     If Sheets("settings").Cells(7, 2).Value = "Process" Then procMBO = True
  99.     If Sheets("settings").Cells(8, 2).Value = "Process" Then procMBid = True
  100.     If Sheets("settings").Cells(9, 2).Value = "Yes" Then blnAutoFilter = True
  101.     If Sheets("settings").Cells(10, 2).Value = "Yes" Then blnCurrencyFormat = True
  102.    
  103.     ReDim arrItemIDs(150000)
  104.     ReDim arrAS(500000, 19)
  105.     ReDim arrAF(500000, 15)
  106.     ReDim arrMBO(500000, 17)
  107.     ReDim arrMBid(500000, 17)
  108.    
  109.     mxas = 1
  110.     mxaf = 1
  111.     mxmb = 1
  112.     mxmbid = 1
  113.        
  114.    
  115.     Set myRegExp1 = New RegExp: myRegExp1.IgnoreCase = True: myRegExp1.Global = True: myRegExp1.MultiLine = True
  116.     Set myRegExp2 = New RegExp: myRegExp2.IgnoreCase = True: myRegExp2.Global = True: myRegExp2.MultiLine = True
  117.     Set myRegExp3 = New RegExp: myRegExp3.IgnoreCase = True: myRegExp3.Global = True: myRegExp3.MultiLine = True
  118.     Set myRegExp4 = New RegExp: myRegExp4.IgnoreCase = True: myRegExp4.Global = True: myRegExp4.MultiLine = True
  119.     Set myregexp5 = New RegExp: myregexp5.IgnoreCase = True: myregexp5.Global = True: myregexp5.MultiLine = True
  120.     Set myregexp6 = New RegExp: myregexp6.IgnoreCase = True: myregexp6.Global = True: myregexp6.MultiLine = True
  121.     Set myregexp7 = New RegExp: myregexp7.IgnoreCase = True: myregexp7.Global = True: myregexp7.MultiLine = True
  122.     Set myregexp8 = New RegExp: myregexp8.IgnoreCase = True: myregexp8.Global = True: myregexp8.MultiLine = True
  123.     Set myregexp9 = New RegExp: myregexp9.IgnoreCase = True: myregexp9.Global = True: myregexp9.MultiLine = True
  124.     Set myRegExp10 = New RegExp: myRegExp10.IgnoreCase = True: myRegExp10.Global = True: myRegExp10.MultiLine = True
  125.    
  126.     myRegExp10.Pattern = "^\t\[""([\s\S]*?)""] = {([\s\S]*?)^\t},$"
  127.     myRegExp1.Pattern = "^BeanCounterDBNames = {([\s\S]*?)^}$"
  128.     myRegExp2.Pattern = "^[\s\S]*?\[""(\d+?):[\s\S]*?;([\s\S]*?)"","
  129.     myRegExp3.Pattern = "^\t\t\[""(\S*?)""] = {([\s\S]*?)^\t\t},$"
  130.     'myRegExp3.Pattern = "^\t\t\[""(\w*?)""] = {([\s\S]*?)^\t\t},$"
  131.    myRegExp4.Pattern = "^\t\t\t\[""(\w*?)""] = {([\s\S]*?)^\t\t\t},"
  132.     myregexp5.Pattern = "^\t\t\t\t\[""(\w*?)""] = {([\s\S]*? = {[\s\S]*?)^\t\t\t\t},"
  133.     myregexp6.Pattern = """([\s\S]*?)""[\s\S]*?"
  134.     myregexp7.Pattern = "^\t\t\t\t\[""(\w*?)""] = {([\s\S]*? = {[\s\S]*?)^\t\t\t\t},"
  135.     myregexp8.Pattern = "^\t\t\t\t\t\[""([\s\S]*?)""] = {([\s\S]*?)^\t\t\t\t\t},"
  136.     myregexp9.Pattern = """([\s\S]*?)""[\s\S]*?"
  137.    
  138.  
  139.     Open inputFile For Input As #1
  140. '   replacing my code with the one suggested by subxero to support unicode chars
  141. '    fileContents = Input$(LOF(1), 1)
  142. '   Close #1
  143.    Dim readlua
  144.     Set readlua = CreateObject("ADODB.Stream")
  145.     readlua.Charset = "utf-8"
  146.     readlua.Open
  147.     readlua.LoadFromFile inputFile
  148.     fileContents = readlua.ReadText
  149.     readlua.Close
  150.     Close #1
  151.     Set myMatches = myRegExp1.Execute(fileContents)  ' settings,itemIDArray,Servername
  152.    For Each myMatch In myMatches
  153.             Set myItems = myRegExp2.Execute(myMatch.SubMatches(0))  '      ["36904:0"] = "cffffffff;Tiger Lily",
  154.            For Each myItem In myItems
  155.                 arrItemIDs(myItem.SubMatches(0)) = myItem.SubMatches(1)
  156.             Next
  157.     Next
  158.    
  159.     Set myMatches = myRegExp10.Execute(fileContents)  ' settings,itemIDArray,Servername
  160.    
  161.     For Each myMatch In myMatches
  162.     Select Case myMatch.SubMatches(0)
  163.        
  164.     Case "settings"
  165.         'do nothing
  166.        
  167.        
  168.     Case ServerName
  169.         nx = 1
  170.         Set myChars = myRegExp3.Execute(myMatch.SubMatches(1))  ' charnames
  171.        For Each mychar In myChars
  172.             If CharacterName = "" Or CharacterName = mychar.SubMatches(0) Then
  173.                 Set myinformation = myRegExp4.Execute(mychar.SubMatches(1)) '   completedAuctions, vendorbuy, etc
  174.                For Each myinfo In myinformation
  175.                     Select Case myinfo.SubMatches(0)
  176.                    
  177.                         Case "completedAuctions"
  178.                             If procAS Then
  179.                                 Set completedAuctions = myregexp5.Execute(myinfo.SubMatches(1))
  180.                                 For Each completedauction In completedAuctions
  181.                                     Set compledauctionsubitems = myregexp8.Execute(completedauction.SubMatches(1))
  182.                                     For Each compledauctionsubitem In compledauctionsubitems
  183.                                         Set completedAuctiondetails = myregexp6.Execute(compledauctionsubitem.SubMatches(1))
  184.                                         For Each completedAuctiondetail In completedAuctiondetails
  185.                                             '"1;4465000;0;235000;4700000;4700000;Asgear;1261957615;;H", -- [1]
  186.                                            dtaarr = Split(completedAuctiondetail.SubMatches(0), ";")
  187.                                             If (Not UseDuration) Or (Abs(DateDiff("s", DateSerial(1970, 1, 1), Now) - dtaarr(7)) <= (Duration * 86400)) Then
  188.                                                 arrAS(mxas, ASStatus) = "Success"
  189.                                                 arrAS(mxas, ASCharName) = mychar.SubMatches(0)
  190.                                                 arrAS(mxas, ASItemName) = arrItemIDs(completedauction.SubMatches(0))
  191.                                                 arrAS(mxas, ASCount) = dtaarr(0)
  192.                                                 If dtaarr(2) = "" Then dtaarr(2) = 0
  193.                                                 arrAS(mxas, ASNetGain) = dtaarr(1) - dtaarr(2)
  194.                                                 arrAS(mxas, ASDeposit) = dtaarr(2)
  195.                                                 If dtaarr(2) <> "" Then arrAS(mxas, ASDepositPer) = dtaarr(2) / dtaarr(0)
  196.                                                 arrAS(mxas, ASFee) = dtaarr(3)
  197.                                                 If dtaarr(3) <> "" Then arrAS(mxas, ASFeePer) = dtaarr(3) / dtaarr(0)
  198.                                                 arrAS(mxas, ASBid) = dtaarr(5)
  199.                                                 If dtaarr(5) <> "" Then arrAS(mxas, ASBidPer) = dtaarr(5) / dtaarr(0)
  200.                                                 arrAS(mxas, ASBuyout) = dtaarr(4)
  201.                                                 If dtaarr(4) <> "" Then arrAS(mxas, ASBuyoutPer) = dtaarr(4) / dtaarr(0)
  202.                                                 arrAS(mxas, ASBuyer) = dtaarr(6)
  203.                                                 arrAS(mxas, ASDay) = Day(NetTimeToVbTime(dtaarr(7)))
  204.                                                 arrAS(mxas, ASMonth) = Month(NetTimeToVbTime(dtaarr(7)))
  205.                                                 arrAS(mxas, ASYear) = Year(NetTimeToVbTime(dtaarr(7)))
  206.                                                 arrAS(mxas, ASFaction) = dtaarr(9)
  207.                                                 arrAS(mxas, ASItemID) = completedauction.SubMatches(0)
  208.                                                 mxas = mxas + 1
  209.                                             End If
  210.                                         Next completedAuctiondetail
  211.                                     Next compledauctionsubitem
  212.                                 Next completedauction
  213.                             End If
  214.                         Case "failedAuctions"
  215.                             If procAF Then
  216.                                 Set failedauctions = myregexp7.Execute(myinfo.SubMatches(1))
  217.                                 For Each failedauction In failedauctions
  218.                                     Set failedauctionsubitems = myregexp8.Execute(failedauction.SubMatches(1))
  219.                                     For Each failedauctionsubitem In failedauctionsubitems
  220.                                         Set failedAuctiondetails = myregexp9.Execute(failedauctionsubitem.SubMatches(1))
  221.                                         For Each failedAuctiondetail In failedAuctiondetails
  222.                                             '"1;;60;;532000;478740;;1261790697;;H", -- [1]
  223.                                            dtaarr = Split(failedAuctiondetail.SubMatches(0), ";")
  224.                                             If (Not UseDuration) Or (Abs(DateDiff("s", DateSerial(1970, 1, 1), Now) - dtaarr(7)) <= (Duration * 86400)) Then
  225.                                                 arrAF(mxaf, ASStatus) = "Failed"
  226.                                                 arrAF(mxaf, ASCharName) = mychar.SubMatches(0)
  227.                                                 arrAF(mxaf, ASItemName) = arrItemIDs(failedauction.SubMatches(0))
  228.                                                 arrAF(mxaf, ASCount) = dtaarr(0)
  229.                                                 arrAF(mxaf, ASDeposit) = dtaarr(2)
  230.                                                 If dtaarr(2) <> "" Then arrAF(mxaf, ASDepositPer) = dtaarr(2) / dtaarr(0)
  231.                                                 arrAF(mxaf, ASBid) = dtaarr(5)
  232.                                                 If dtaarr(5) <> "" Then arrAF(mxaf, ASBidPer) = dtaarr(5) / dtaarr(0)
  233.                                                 arrAF(mxaf, ASBuyout) = dtaarr(4)
  234.                                                 If dtaarr(4) <> "" Then arrAF(mxaf, ASBuyoutPer) = dtaarr(4) / dtaarr(0)
  235.                                                 arrAF(mxaf, ASDay) = Day(NetTimeToVbTime(dtaarr(7)))
  236.                                                 arrAF(mxaf, ASMonth) = Month(NetTimeToVbTime(dtaarr(7)))
  237.                                                 arrAF(mxaf, ASYear) = Year(NetTimeToVbTime(dtaarr(7)))
  238.                                                 arrAF(mxaf, ASFaction) = dtaarr(9)
  239.                                                 arrAF(mxaf, AFItemID) = failedauction.SubMatches(0)
  240.                                                 mxaf = mxaf + 1
  241.                                             End If
  242.                                         Next failedAuctiondetail
  243.                                     Next failedauctionsubitem
  244.                                 Next failedauction
  245.                             End If
  246.                         Case "completedBidsBuyouts"
  247.                             If procMBO Or procMBid Then
  248.                                 Set completedBuyOuts = myregexp5.Execute(myinfo.SubMatches(1))
  249.                                 For Each completedBuyOut In completedBuyOuts
  250.                                     Set compledauctionsubitems = myregexp8.Execute(completedBuyOut.SubMatches(1))
  251.                                     For Each compledauctionsubitem In compledauctionsubitems
  252.                                         Set completedBuyOutdetails = myregexp6.Execute(compledauctionsubitem.SubMatches(1))
  253.                                         For Each completedBuyOutdetail In completedBuyOutdetails
  254.                                             '"1;0;;0;70000;20882;Caponator;1271626072;Disenchant;H", -- [1]
  255.                                            '"1;4465000;0;235000;4700000;4700000;Asgear;1261957615;;H", -- [1]
  256.                                            dtaarr = Split(completedBuyOutdetail.SubMatches(0), ";")
  257.                                             If (Not UseDuration) Or (Abs(DateDiff("s", DateSerial(1970, 1, 1), Now) - dtaarr(7)) <= (Duration * 86400)) Then
  258.                                                 If dtaarr(5) = dtaarr(4) And procMBO Then
  259.                                                     arrMBO(mxmb, ASStatus) = "Bought"
  260.                                                     arrMBO(mxmb, ASCharName) = mychar.SubMatches(0)
  261.                                                     arrMBO(mxmb, ASItemName) = arrItemIDs(completedBuyOut.SubMatches(0))
  262.                                                     arrMBO(mxmb, ASCount) = dtaarr(0)
  263.                                                     arrMBO(mxmb, ASDeposit) = dtaarr(2)
  264.                                                     If dtaarr(2) <> "" Then arrMBO(mxmb, ASDepositPer) = dtaarr(2) / dtaarr(0)
  265.                                                     arrMBO(mxmb, ASBid) = dtaarr(5)
  266.                                                     If dtaarr(5) <> "" Then arrMBO(mxmb, ASBidPer) = dtaarr(5) / dtaarr(0)
  267.                                                     arrMBO(mxmb, ASBuyout) = dtaarr(4)
  268.                                                     If dtaarr(4) <> "" Then arrMBO(mxmb, ASBuyoutPer) = dtaarr(4) / dtaarr(0)
  269.                                                     arrMBO(mxmb, ASBuyer) = dtaarr(6)
  270.                                                     arrMBO(mxmb, ASDay) = Day(NetTimeToVbTime(dtaarr(7)))
  271.                                                     arrMBO(mxmb, ASMonth) = Month(NetTimeToVbTime(dtaarr(7)))
  272.                                                     arrMBO(mxmb, ASYear) = Year(NetTimeToVbTime(dtaarr(7)))
  273.                                                     arrMBO(mxmb, ASFaction) = dtaarr(9)
  274.                                                     arrMBO(mxmb, ASReason) = dtaarr(8)
  275.                                                     arrMBO(mxmb, MBuyoutItemID) = completedBuyOut.SubMatches(0)
  276.                                                     mxmb = mxmb + 1
  277.                                                 ElseIf procMBid Then
  278.                                                     arrMBid(mxmbid, ASStatus) = "Bought"
  279.                                                     arrMBid(mxmbid, ASCharName) = mychar.SubMatches(0)
  280.                                                     arrMBid(mxmbid, ASItemName) = arrItemIDs(completedBuyOut.SubMatches(0))
  281.                                                     arrMBid(mxmbid, ASCount) = dtaarr(0)
  282.                                                     arrMBid(mxmbid, ASDeposit) = dtaarr(2)
  283.                                                     If dtaarr(2) <> "" Then arrMBid(mxmbid, ASDepositPer) = dtaarr(2) / dtaarr(0)
  284.                                                     arrMBid(mxmbid, ASBid) = dtaarr(5)
  285.                                                     If dtaarr(5) <> "" Then arrMBid(mxmbid, ASBidPer) = dtaarr(5) / dtaarr(0)
  286.                                                     arrMBid(mxmbid, ASBuyout) = dtaarr(4)
  287.                                                     If dtaarr(4) <> "" Then arrMBid(mxmbid, ASBuyoutPer) = dtaarr(4) / dtaarr(0)
  288.                                                     arrMBid(mxmbid, ASBuyer) = dtaarr(6)
  289.                                                     arrMBid(mxmbid, ASDay) = Day(NetTimeToVbTime(dtaarr(7)))
  290.                                                     arrMBid(mxmbid, ASMonth) = Month(NetTimeToVbTime(dtaarr(7)))
  291.                                                     arrMBid(mxmbid, ASYear) = Year(NetTimeToVbTime(dtaarr(7)))
  292.                                                     arrMBid(mxmbid, ASFaction) = dtaarr(9)
  293.                                                     arrMBid(mxmbid, ASReason) = dtaarr(8)
  294.                                                     arrMBid(mxmbid, MBidItemID) = completedBuyOut.SubMatches(0)
  295.                                                     mxmbid = mxmbid + 1
  296.                                                 End If
  297.                                             End If
  298.                                         Next completedBuyOutdetail
  299.                                      Next compledauctionsubitem
  300.                                  Next completedBuyOut
  301.                             End If
  302.                         Case "version"
  303.                         Case "faction"
  304.                         Case "wealth"
  305.                         Case "vendorbuy"
  306.                         Case "vendorsell"
  307.                         Case "postedAuctions"
  308.                         Case "postedBids"
  309.                         Case "failedBids"
  310.                         Case "completedAuctionsNeutral"
  311.                         Case "failedAuctionsNeutral"
  312.                         Case "completedBidsBuyoutsNeutral"
  313.                         Case "failedBidsNeutral"
  314.                         Case "mailbox"
  315.                         End Select
  316.                        
  317.                         nx = nx + 1
  318.                    
  319.                     Next myinfo
  320.                 End If
  321.             Next mychar
  322.         End Select
  323.     Next
  324.  
  325.    
  326.    
  327.     Sheets("AuctionsSuccess").Range("A2:S500001") = arrAS
  328.     Sheets("AuctionsSuccess").Rows(mxas + 1 & ":500001").Delete
  329.     Sheets("AuctionsFailed").Range("A2:O500001") = arrAF
  330.     Sheets("AuctionsFailed").Rows(mxaf + 1 & ":500001").Delete
  331.     Sheets("MyBuyouts").Range("A2:Q500001") = arrMBO
  332.     Sheets("MyBuyouts").Rows(mxmb + 1 & ":500001").Delete
  333.     Sheets("MyBids").Range("A2:Q500001") = arrMBid
  334.     Sheets("MyBids").Rows(mxmbid + 1 & ":500001").Delete
  335.     If blnAutoFilter Then
  336.         Sheets("AuctionsSuccess").Cells(1, 1).CurrentRegion.AutoFilter
  337.         Sheets("AuctionsFailed").Cells(1, 1).CurrentRegion.AutoFilter
  338.         Sheets("MyBuyouts").Cells(1, 1).CurrentRegion.AutoFilter
  339.         Sheets("MyBids").Cells(1, 1).CurrentRegion.AutoFilter
  340.     End If
  341.    
  342.     If blnCurrencyFormat Then
  343.         Sheets("AuctionsSuccess").Range("F:K").NumberFormat = "0""g ""##""s ""##""c"""
  344.         Sheets("AuctionsSuccess").Range("P:R").NumberFormat = "0""g ""##""s ""##""c"""
  345.         Sheets("AuctionsFailed").Range("F:K").NumberFormat = "0""g ""##""s ""##""c"""
  346.         Sheets("MyBuyouts").Range("F:I").NumberFormat = "0""g ""##""s ""##""c"""
  347.         Sheets("MyBids").Range("F:I").NumberFormat = "0""g ""##""s ""##""c"""
  348.     End If
  349.     Application.EnableCancelKey = xlenabled
  350. 'Debug.Print Now
  351.    MsgBox "Done"
  352. End Sub
  353.  
  354. Private Sub Clearing()
  355.     Sheets("AuctionsSuccess").Cells.clear
  356.     Sheets("AuctionsFailed").Cells.clear
  357.     Sheets("MyBuyouts").Cells.clear
  358.     Sheets("MyBids").Cells.clear
  359.    
  360.    
  361.     Sheets("AuctionsSuccess").Cells(1, ASStatus).Value = "Status"
  362.     Sheets("AuctionsSuccess").Cells(1, ASCharName).Value = "CharacterName"
  363.     Sheets("AuctionsSuccess").Cells(1, ASItemName).Value = "ItemName"
  364.     Sheets("AuctionsSuccess").Cells(1, ASCount).Value = "Count"
  365.     Sheets("AuctionsSuccess").Cells(1, ASNetGain).Value = "NetGain"
  366.     Sheets("AuctionsSuccess").Cells(1, ASBid).Value = "Bid"
  367.     Sheets("AuctionsSuccess").Cells(1, ASBidPer).Value = "BidPer"
  368.     Sheets("AuctionsSuccess").Cells(1, ASBuyout).Value = "Buyout"
  369.     Sheets("AuctionsSuccess").Cells(1, ASBuyoutPer).Value = "BuyoutPer"
  370.     Sheets("AuctionsSuccess").Cells(1, ASDeposit).Value = "Deposit"
  371.     Sheets("AuctionsSuccess").Cells(1, ASDepositPer).Value = "DepositPer"
  372.     Sheets("AuctionsSuccess").Cells(1, ASFee).Value = "Fee"
  373.     Sheets("AuctionsSuccess").Cells(1, ASFeePer).Value = "FeePer"
  374.     Sheets("AuctionsSuccess").Cells(1, ASDay).Value = "Day"
  375.     Sheets("AuctionsSuccess").Cells(1, ASMonth).Value = "Month"
  376.     Sheets("AuctionsSuccess").Cells(1, ASYear).Value = "Year"
  377.     Sheets("AuctionsSuccess").Cells(1, ASBuyer).Value = "Buyer"
  378.     Sheets("AuctionsSuccess").Cells(1, ASFaction).Value = "Faction"
  379.    
  380.     Sheets("AuctionsFailed").Cells(1, ASStatus).Value = "Status"
  381.     Sheets("AuctionsFailed").Cells(1, ASCharName).Value = "CharacterName"
  382.     Sheets("AuctionsFailed").Cells(1, ASItemName).Value = "ItemName"
  383.     Sheets("AuctionsFailed").Cells(1, ASCount).Value = "Count"
  384.     Sheets("AuctionsFailed").Cells(1, ASBid).Value = "Bid"
  385.     Sheets("AuctionsFailed").Cells(1, ASBidPer).Value = "BidPer"
  386.     Sheets("AuctionsFailed").Cells(1, ASBuyout).Value = "Buyout"
  387.     Sheets("AuctionsFailed").Cells(1, ASBuyoutPer).Value = "BuyoutPer"
  388.     Sheets("AuctionsFailed").Cells(1, ASDeposit).Value = "Deposit"
  389.     Sheets("AuctionsFailed").Cells(1, ASDepositPer).Value = "DepositPer"
  390.     Sheets("AuctionsFailed").Cells(1, ASDay).Value = "Day"
  391.     Sheets("AuctionsFailed").Cells(1, ASMonth).Value = "Month"
  392.     Sheets("AuctionsFailed").Cells(1, ASYear).Value = "Year"
  393.     Sheets("AuctionsFailed").Cells(1, ASFaction).Value = "Faction"
  394.    
  395.     Sheets("MyBuyouts").Cells(1, ASStatus).Value = "Status"
  396.     Sheets("MyBuyouts").Cells(1, ASCharName).Value = "CharacterName"
  397.     Sheets("MyBuyouts").Cells(1, ASItemName).Value = "ItemName"
  398.     Sheets("MyBuyouts").Cells(1, ASCount).Value = "Count"
  399.     Sheets("MyBuyouts").Cells(1, ASBid).Value = "Bid"
  400.     Sheets("MyBuyouts").Cells(1, ASBidPer).Value = "BidPer"
  401.     Sheets("MyBuyouts").Cells(1, ASBuyout).Value = "Buyout"
  402.     Sheets("MyBuyouts").Cells(1, ASBuyoutPer).Value = "BuyoutPer"
  403.     Sheets("MyBuyouts").Cells(1, ASDeposit).Value = "Deposit"
  404.     Sheets("MyBuyouts").Cells(1, ASDepositPer).Value = "DepositPer"
  405.     Sheets("MyBuyouts").Cells(1, ASDay).Value = "Day"
  406.     Sheets("MyBuyouts").Cells(1, ASMonth).Value = "Month"
  407.     Sheets("MyBuyouts").Cells(1, ASYear).Value = "Year"
  408.     Sheets("MyBuyouts").Cells(1, ASBuyer).Value = "Seller"
  409.     Sheets("MyBuyouts").Cells(1, ASFaction).Value = "Faction"
  410.     Sheets("MyBuyouts").Cells(1, ASReason).Value = "Reason"
  411.    
  412.     Sheets("MyBids").Cells(1, ASStatus).Value = "Status"
  413.     Sheets("MyBids").Cells(1, ASCharName).Value = "CharacterName"
  414.     Sheets("MyBids").Cells(1, ASItemName).Value = "ItemName"
  415.     Sheets("MyBids").Cells(1, ASCount).Value = "Count"
  416.     Sheets("MyBids").Cells(1, ASBid).Value = "Bid"
  417.     Sheets("MyBids").Cells(1, ASBidPer).Value = "BidPer"
  418.     Sheets("MyBids").Cells(1, ASBuyout).Value = "Buyout"
  419.     Sheets("MyBids").Cells(1, ASBuyoutPer).Value = "BuyoutPer"
  420.     Sheets("MyBids").Cells(1, ASDeposit).Value = "Deposit"
  421.     Sheets("MyBids").Cells(1, ASDepositPer).Value = "DepositPer"
  422.     Sheets("MyBids").Cells(1, ASDay).Value = "Day"
  423.     Sheets("MyBids").Cells(1, ASMonth).Value = "Month"
  424.     Sheets("MyBids").Cells(1, ASYear).Value = "Year"
  425.     Sheets("MyBids").Cells(1, ASBuyer).Value = "Seller"
  426.     Sheets("MyBids").Cells(1, ASFaction).Value = "Faction"
  427.     Sheets("MyBids").Cells(1, ASReason).Value = "Reason"
  428.    
  429. End Sub
  430.  
  431.  
  432.  
  433.  
  434.  
  435.  
  436. Private Function NetTimeToVbTime(NetDate As Variant) As Double
  437.     Const BaseDate# = 25569   'DateSerial(1970, 1, 1)
  438.    Const SecsPerDay# = 86400
  439.     NetTimeToVbTime = BaseDate + (CDbl(NetDate) / SecsPerDay)
  440. End Function
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement