VERSION 5.00 Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX" Object = "{67397AA1-7FB1-11D0-B148-00A0C922E820}#6.0#0"; "MSADODC.OCX" Begin VB.Form Form1 Caption = "Form1" ClientHeight = 8415 ClientLeft = 60 ClientTop = 345 ClientWidth = 11805 LinkTopic = "Form1" ScaleHeight = 8415 ScaleWidth = 11805 StartUpPosition = 2 '螢幕中央 WindowState = 2 '最大化 Begin VB.TextBox Text3 Height = 372 Left = 1080 TabIndex = 10 Text = "1" Top = 1200 Width = 375 End Begin VB.Data Data2 Caption = "Data1" Connect = "Access" DatabaseName = "C:\Tmp\Vb\user000.mdb" DefaultCursorType= 0 '預設的資料指標 DefaultType = 2 '使用 ODBCDirect Exclusive = 0 'False Height = 615 Left = 120 Options = 0 ReadOnly = 0 'False RecordsetType = 0 '資料表(Table) RecordSource = "" Top = 5880 Width = 1140 End Begin VB.CommandButton Command3 BackColor = &H00FFC0C0& Caption = "3.測試區二" Height = 375 Left = 240 Style = 1 '圖片外觀 TabIndex = 9 Top = 4320 Width = 1215 End Begin VB.FileListBox File1 Height = 2070 Left = 1800 Pattern = "*.htm*" TabIndex = 8 Top = 4200 Width = 4575 End Begin VB.TextBox Text2 Height = 372 Left = 1080 TabIndex = 7 Text = "1" Top = 720 Width = 375 End Begin VB.Data Data1 Caption = "Data1" Connect = "Access" DatabaseName = "C:\Tmp\Vb\user000.mdb" DefaultCursorType= 0 '預設的資料指標 DefaultType = 2 '使用 ODBCDirect Exclusive = 0 'False Height = 615 Left = 120 Options = 0 ReadOnly = 0 'False RecordsetType = 0 '資料表(Table) RecordSource = "" Top = 5280 Width = 1140 End Begin MSAdodcLib.Adodc Adodc1 Height = 495 Left = 120 Top = 6600 Width = 1200 _ExtentX = 2117 _ExtentY = 873 ConnectMode = 0 CursorLocation = 3 IsolationLevel = -1 ConnectionTimeout= 15 CommandTimeout = 30 CursorType = 3 LockType = 3 CommandType = 8 CursorOptions = 0 CacheSize = 50 MaxRecords = 0 BOFAction = 0 EOFAction = 0 ConnectStringType= 1 Appearance = 1 BackColor = -2147483643 ForeColor = -2147483640 Orientation = 0 Enabled = -1 Connect = "" OLEDBString = "" OLEDBFile = "" DataSourceName = "" OtherAttributes = "" UserName = "" Password = "" RecordSource = "" Caption = "Adodc1" BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} Name = "新細明體" Size = 9 Charset = 136 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty _Version = 393216 End Begin VB.CommandButton Command1 BackColor = &H00FFC0FF& Caption = "1.轉換資料庫" Height = 375 Left = 240 Style = 1 '圖片外觀 TabIndex = 6 Top = 240 Width = 1215 End Begin VB.TextBox Text1 Height = 495 Left = 1800 TabIndex = 2 Text = "Text1" Top = 3600 Width = 9975 End Begin MSWinsockLib.Winsock Winsock1 Left = 120 Top = 4800 _ExtentX = 741 _ExtentY = 741 _Version = 393216 End Begin VB.CommandButton Command2 BackColor = &H00C0FFC0& Caption = "2.測試區" Height = 375 Left = 240 Style = 1 '圖片外觀 TabIndex = 1 Top = 3840 Width = 1215 End Begin VB.ListBox List1 Height = 3120 Left = 1800 TabIndex = 0 Top = 240 Width = 9855 End Begin VB.Label Label5 Caption = "啟始編號" Height = 375 Left = 120 TabIndex = 12 Top = 1200 Width = 975 End Begin VB.Label Label4 Caption = "啟始筆數" Height = 375 Left = 120 TabIndex = 11 Top = 720 Width = 855 End Begin VB.Label Label3 Caption = "Label3" Height = 255 Left = 120 TabIndex = 5 Top = 2640 Width = 615 End Begin VB.Label Label2 Caption = "Label2" Height = 255 Left = 120 TabIndex = 4 Top = 2400 Width = 495 End Begin VB.Label Label1 Caption = "Label1" Height = 255 Left = 120 TabIndex = 3 Top = 2160 Width = 495 End End Attribute VB_Name = "Form1" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False 'Ebay 管理 '由PAYPAL的csv轉入DV的pd-list.mdb並產生成交日報表給詩菁,1天兩次.最後給DV pd-list.mdb '-->>pd-list.mdb '->Paypal-history '->Paypal-history-work '->pd-profile '->成交日報表 'Option Explicit Private daoDB36 As Database Private rs As DAO.Recordset Dim sPath As String 'ada Dim y1, LL, asx1, asx2, asx As Long '1.轉換資料庫 Dim Inpt_Line1, asw, VarName As String Dim TheFileName As String 'ADA 轉檔參數 Dim db As Database Dim rs1 As Recordset Dim rs2 As Recordset Dim rs3 As Recordset Dim C1 As String Dim C3 As Integer Dim S_Work, S_Array, S_Job As String '2.篩選資料庫 Dim Cnt As Long Dim req As String Option Base 1 Dim Xml_Value(400) As String '定義陣列給xml欄位 Dim word_c As Integer '定義陣列計數 Dim SignPrice As Long '贈送簽名的金額 Dim ItemWeight As Long '郵寄重量 Private Sub Command2_Click() 'Open App.Path & "\pdlst.txt" For Input As #3 Open App.Path & "\pdlst.txt" For Input As #3 List1.Clear '設定欲修改的指標啟始位置 TL_itemid_count = 0 Line_c = 1 Start_flag = 0 Temp_userid_start = 0 Do While Not EOF(3) 'Do While Line_c < 100 Line Input #3, TextLine Line_c = Line_c + 1 List1.AddItem TextLine List1.Selected(List1.ListCount - 1) = True Loop Close #3 End Sub Private Sub Form_Load() 'pd-list.mdb sPath = App.Path & "\pd-list.mdb" Set daoDB36 = DBEngine(0).OpenDatabase(sPath, False, False, "MS Access;PWD=1234") Set rs1 = daoDB36.OpenRecordset("Paypal-history-work") Set Data1.Recordset = rs1 Set rs2 = daoDB36.OpenRecordset("pd-profile") Set Data2.Recordset = rs2 Set rs3 = daoDB36.OpenRecordset("成交日報表") Set Data2.Recordset = rs3 '附加簽名的贈送金額 SignPrice = 80 End Sub '1.依Paypal-history-work和pd-profile轉成成交日報表資料表 ' =========================== Private Sub Command1_Click() '匯入TL資料庫 '重量的值 ItemWeight = 0 '重量的單位 WeightUnit = "" List1.Clear '設定欲修改的指標啟始位置 TL_itemid_count = Int(Text2.Text) Rs1_c = Int(Text3.Text) rs1.MoveFirst Do While Not rs1.EOF List1.AddItem Rs1_c rs2.Index = "Item Title" rs2.Seek "=", rs1.Fields("Item Title") If Not rs2.NoMatch Then '等新貨到再啟用 'List1.AddItem "9" + rs2.Fields("標準郵寄方式") + "9" 'List1.AddItem "9" + rs1.Fields("Quantity") + "9" 'If ((rs2.Fields("標準郵寄方式") <> "USPS-FirstClass") Or (rs1.Fields("Quantity") <> "1")) Then rs3.AddNew '用PST但加一行AM0~4:00減一天 rs3.Fields("成交流水號") = Format(Date, "YYYYMMDD") + "-" + Format(Rs1_c, "000") '同一Buyer要算-2 rs3.Fields("成交ID") = rs1.Fields("Item ID") + "-" + rs1.Fields("Buyer ID") + "-" + "1" rs3.Fields("EbayItemNo") = rs1.Fields("Item ID") rs3.Fields("BuyerID") = rs1.Fields("Buyer ID") rs3.Fields("產品簡稱") = rs2.Fields("產品簡稱") rs3.Fields("產品title") = rs1.Fields("Item Title") rs3.Fields("付款人姓名") = rs1.Fields("Name") '客戶匯款金額 rs3.Fields("付款金額") = CDbl(rs1.Fields("Gross")) rs3.Fields("付款人備註") = rs1.Fields("Note") rs3.Fields("數量") = rs1.Fields("Quantity") rs3.Fields("PayPal成交ID") = rs1.Fields("Transaction ID") rs3.Fields("產品編號") = rs2.Fields("產品編號") '郵寄重量=產品單重*數量+包裝材料重(???數量多的包裝材料怎麼算,DV:先不算) '公克 'ItemWeight = Trim(Str(CDbl(rs2.Fields("產品單重")) * CDbl(rs1.Fields("Quantity")) + CDbl(rs2.Fields("包裝材料重")))) ItemWeight = CDbl(rs2.Fields("產品單重")) * CDbl(rs1.Fields("Quantity")) + CDbl(rs2.Fields("包裝材料重")) '超出11 OZ(盎司),不含11 OZ,算 LB(磅),1磅=448克 If rs2.Fields("標準郵寄方式") = "USPS-Priority" Then rs3.Fields("郵寄方式") = "P" If InStr(ItemWeight / 448, ".") <> 0 Then ItemWeightTemp = Trim(Str(roundDown(ItemWeight / 448) + 1)) rs3.Fields("重量") = ItemWeightTemp + "_LB" Else rs3.Fields("重量") = Trim(Str(roundDown(ItemWeight / 448))) + "_LB" End If Else If rs2.Fields("標準郵寄方式") = "USPS-Media" Then rs3.Fields("郵寄方式") = "M" If InStr(ItemWeight / 448, ".") <> 0 Then ItemWeightTemp = Trim(Str(roundDown(ItemWeight / 448) + 1)) rs3.Fields("重量") = ItemWeightTemp + "_LB" Else rs3.Fields("重量") = Trim(Str(roundDown(ItemWeight / 448))) + "_LB" End If Else If ItemWeight >= 336 Then rs3.Fields("郵寄方式") = "P" 'WeightUnit = "LB" If InStr(ItemWeight / 448, ".") <> 0 Then ItemWeightTemp = Trim(Str(roundDown(ItemWeight / 448) + 1)) rs3.Fields("重量") = ItemWeightTemp + "_LB" Else rs3.Fields("重量") = Trim(Str(roundDown(ItemWeight / 448))) + "_LB" End If Else rs3.Fields("郵寄方式") = "1ST" 'WeightUnit = "OZ" If InStr(ItemWeight / 28.34, ".") <> 0 Then ItemWeightTemp = Trim(Str(roundDown(ItemWeight / 28.34) + 1)) rs3.Fields("重量") = ItemWeightTemp + "_OZ" Else rs3.Fields("重量") = Trim(Str(roundDown(ItemWeight / 28.34))) + "_OZ" End If End If End If End If List1.AddItem ItemWeight List1.Selected(List1.ListCount - 1) = True '金額超過值就送簽名 If rs1.Fields("Gross") >= SignPrice Then rs3.Fields("附加簽名") = "O" Else rs3.Fields("附加簽名") = "X" End If '檢查有沒有付附加保險-931227 If rs1.Fields("Insurance Amount") > 0 Then rs3.Fields("附加保險") = "O" Else rs3.Fields("附加保險") = "X" End If If rs1.Fields("Address Status") = "Confirmed" Then rs3.Fields("地址確認") = "O" Else rs3.Fields("地址確認") = "X" End If rs3.Fields("付款日期") = rs1.Fields("Date") rs3.Fields("付款時間") = rs1.Fields("Time") rs3.Fields("收件人姓名") = Mid(rs1.Fields("Shipping Address"), 1, InStr(rs1.Fields("Shipping Address"), ",") - 1) rs3.Fields("From Email Address") = rs1.Fields("From Email Address") rs3.Fields("Gallery圖片連結") = rs2.Fields("Gallery圖片連結") rs3.Update Rs1_c = Rs1_c + 1 'Print "========== Update ok ===========" 'End If End If rs1.MoveNext Loop End Sub '3.測試區二-將陣列中XML符合的項目變更內容 Private Sub Command3_Click() 'List1.AddItem (57 \ 28) 'If InStr(57 / 28, ".") <> 0 Then 'List1.AddItem Mid(57 / 28, InStr(57 / 28, ".")) 'If Mid(57 / 28, InStr(57 / 28, ".")) > 0 Then ' List1.AddItem "1" 'Else ' List1.AddItem "0" 'End If 'End If If InStr(85 / 28.34, ".") <> 0 Then List1.AddItem Trim(Str(roundDown(85 \ 28.34) + 1)) List1.AddItem roundDown(85 / 28.34) 'List1.AddItem roundUp(85 / 28.34) 'List1.AddItem (85 \ 28.34) Else List1.AddItem "2" + Trim(Str((ItemWeight \ 28.34))) + "_OZ" End If 'List1.AddItem Hour(Now()) List1.Selected(List1.ListCount - 1) = True End Sub '強制去位 Public Function roundDown(dblValue As Double) As Double On Error GoTo PROC_ERR Dim myDec As Long myDec = InStr(1, CStr(dblValue), ".", vbTextCompare) If myDec > 0 Then roundDown = CDbl(Left(CStr(dblValue), myDec)) Else roundDown = dblValue End If PROC_EXIT: Exit Function PROC_ERR: MsgBox Err.Description, vbInformation, "Round Down" End Function Public Function roundUp(dblValue As Double) As Double On Error GoTo PROC_ERR Dim myDec As Long myDec = InStr(1, CStr(dblValue), ".", vbTextCompare) If myDec > 0 Then roundUp = CDbl(Left(CStr(dblValue), myDec)) + 1 Else roundUp = dblValue End If PROC_EXIT: Exit Function PROC_ERR: MsgBox Err.Description, vbInformation, "Round Up" End Function