加入 CodeStore VBA 模組
This commit is contained in:
zhi committed
1 parent
9c5364f88e
commit
0e638bdd15
22 files changed
+4510
No files matched your search
@@ -0,0 +1,198 @@
|
||||
Attribute VB_Name = "Module1"
|
||||
'**************** MySQL變數 ******************
|
||||
Const server_name = "ms1.tc-clothing.com" ' 伺服器IP，127.0.0.1為目前本機
|
||||
Const database_name = "clothing" ' 連線資料庫名稱
|
||||
Const user_id = "clothing" ' 資料庫登入帳號
|
||||
Const UPassword = "clo256" ' 資料庫登入密碼
|
||||
'********************************************
|
||||
Public PYEAR As Integer
|
||||
Public PCOMPANY As Integer
|
||||
Public XLSfile As String
|
||||
|
||||
|
||||
Public Function Cnmyopen() As ADODB.Connection
|
||||
Dim conn As New ADODB.Connection
|
||||
Dim connStr As String '資料庫連線字串，其中5.3為ODBC驅動程式版本，要配合你安裝的驅動。
|
||||
connStr = "DRIVER={MariaDB ODBC 3.2 Driver}" _
|
||||
& ";SERVER=" & server_name _
|
||||
& ";DATABASE=" & database_name _
|
||||
& ";UID=" & user_id _
|
||||
& ";PWD=" & UPassword
|
||||
conn.Open connStr
|
||||
Set Cnmyopen = conn
|
||||
' 傳回Connection
|
||||
End Function
|
||||
|
||||
Public Function Cnxnopen(strSQL As String, v_imex As String) As ADODB.Connection
|
||||
' strSQL 寫入檔案 v_imex 1=唯讀 0=寫入
|
||||
Dim conn As New ADODB.Connection
|
||||
Dim connStr As String '資料庫連線字串
|
||||
connStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & Excel.ThisWorkbook.path & _
|
||||
strSQL & ";Extended Properties=""Excel 12.0;HDR=Yes;IMEX=" & v_imex & ";"";"
|
||||
conn.Open connStr
|
||||
Set Cnxnopen = conn
|
||||
' 傳回Connection
|
||||
End Function
|
||||
|
||||
Public Function rstCnxnopen(strXLSfile As String, strSQL As String) As ADODB.Recordset
|
||||
' 開啟Excel表
|
||||
Dim Cnxn As ADODB.Connection
|
||||
Dim rstXLS As New ADODB.Recordset
|
||||
Set Cnxn = Cnxnopen(strXLSfile, "1")
|
||||
rstXLS.Open strSQL, Cnxn, adOpenStatic, adLockOptimistic, adCmdText
|
||||
Set rstCnxnopen = rstXLS
|
||||
' 傳回Recordset
|
||||
End Function
|
||||
|
||||
Public Function rstCnmyopen(Cnmy As ADODB.Connection, strSQL As String) As ADODB.Recordset
|
||||
' 開啟Mysql表
|
||||
Dim rstSQL As ADODB.Recordset
|
||||
Set rstSQL = New ADODB.Recordset
|
||||
rstSQL.CursorLocation = 3 'mysql RecordCount連線BUG by 藍色小舖 老頑童
|
||||
rstSQL.Open strSQL, Cnmy
|
||||
Set rstCnmyopen = rstSQL
|
||||
' 傳回Recordset
|
||||
End Function
|
||||
|
||||
Public Function sqlCnxnexec(strXLSfile As String, strSQL As String)
|
||||
' 執行SQL
|
||||
Dim cn As New ADODB.Connection
|
||||
' Dim Cnxn As ADODB.Connection
|
||||
' Set Cnxn = Cnxnopen(strXLSfile, "1")
|
||||
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
|
||||
"Data Source=" & Excel.ThisWorkbook.path & strXLSfile & ";" & _
|
||||
"Extended Properties=""Excel 8.0;HDR=YES;IMEX=0"""
|
||||
cn.Execute strSQL
|
||||
|
||||
End Function
|
||||
|
||||
Public Sub truncate_data(Cnmy As ADODB.Connection, SQLYear As Variant, SQLCompany As Variant)
|
||||
' SQLYear 年度 SQLCompany 公司代碼
|
||||
Dim strSQL As String
|
||||
strSQL = "delete FROM CUSTOMER where id BETWEEN " & SQLYear & SQLCompany & "0000 AND " & SQLYear & SQLCompany & "9999;"
|
||||
' debug.print strSQL
|
||||
Cnmy.Execute strSQL '刪除名冊
|
||||
strSQL = "delete FROM SELLUP where id BETWEEN " & SQLYear & SQLCompany & "0000 AND " & SQLYear & SQLCompany & "9999;"
|
||||
' debug.print strSQL
|
||||
Cnmy.Execute strSQL '刪除購買
|
||||
' 清除舊資料
|
||||
End Sub
|
||||
|
||||
Public Sub insert_data(Cnmy As ADODB.Connection, rstTBL As ADODB.Recordset, SQLYear As Variant, SQLCompany As Variant)
|
||||
' 匯入名冊資料 量身尺寸
|
||||
' rstTBL Excel檔案 SQLYear 年度 SQLCompany 公司
|
||||
Dim sb As StringBuilder
|
||||
Set sb = New StringBuilder
|
||||
'====================================+
|
||||
Dim p As Long '+
|
||||
Dim diag As New ProgressDialogue '+
|
||||
'====================================+
|
||||
' 建立正規表示法變數
|
||||
Dim Regex As New RegExp
|
||||
'===================================================================================+
|
||||
p = 0 '+
|
||||
diag.Configure "更新資料時間", "Now wasting your time...", 0, rstTBL.RecordCount '+
|
||||
diag.Show '+
|
||||
'===================================================================================+
|
||||
sb.Append "INSERT INTO CUSTOMER(id,regdate,company,department,seat,cus_no,cus_name,cus_sex,chest,waist,hip,leg,height,weight,trousers,tailor) VALUES "
|
||||
While Not rstTBL.EOF
|
||||
With rstTBL.Fields
|
||||
If Not IsNull(.item("c_name")) Then
|
||||
sb.Append "(" & .item("ID") & "," 'Field id
|
||||
sb.Append "'" & .item("regdate") & "'," 'Field regdate
|
||||
sb.Append "" & .item("company") & "," 'Field company
|
||||
sb.Append "" & .item("depart") & "," 'Field department
|
||||
sb.Append "" & .item("seat") & "," 'Field seat
|
||||
sb.Append "'" & .item("cus_no") & "'," 'Field cus_no
|
||||
' 設定匹配規則
|
||||
Regex.Pattern = "[^\u4E00-\u9FA5\u3000-\u303F\uFF00-\uFFEF\u0000-\u007F\u201c-\u201d]"
|
||||
If Regex.test(.item("c_name")) Then Debug.Print .item("ID")
|
||||
sb.Append "'" & .item("c_name") & "'," 'Field cus_name
|
||||
sb.Append "" & .item("sex") & "," 'Field cus_sex
|
||||
sb.Append "" & .item("chest") & "," 'Field chest
|
||||
sb.Append "" & .item("waist") & "," 'Field waist
|
||||
sb.Append "" & .item("hip") & "," 'Field hip
|
||||
sb.Append "" & .item("leg") & "," 'Field leg
|
||||
sb.Append "" & .item("height") & "," 'Field height
|
||||
sb.Append "" & .item("weight") & "," 'Field weight
|
||||
sb.Append "" & .item("trousers") & "," 'Field trousers
|
||||
sb.Append "" & .item("tailor") & ")" 'Field tailor
|
||||
End If
|
||||
End With
|
||||
rstTBL.MoveNext
|
||||
If Not rstTBL.EOF Then sb.Append ","
|
||||
'================================================+
|
||||
diag.SetValue p '+
|
||||
diag.SetStatus "Now wasting your time... " & p '+
|
||||
p = p + 1 '+
|
||||
'================================================+
|
||||
Wend
|
||||
' strSQL = Left(strSQL, Len(strSQL) - 1)
|
||||
' Debug.Print sb.tostring
|
||||
Cnmy.Execute sb.ToString
|
||||
'============+
|
||||
diag.Hide '+
|
||||
'============+
|
||||
'更新服裝尺碼
|
||||
' Application.Calculation = xlAutomatic ' 設置自動重算
|
||||
' MsgBox "更新完成！"
|
||||
End Sub
|
||||
|
||||
Public Sub insert_data2(Cnmy As ADODB.Connection, rstXLS As ADODB.Recordset, SQLYear As Variant, SQLCompany As Variant)
|
||||
' 新增資料段2 服裝尺碼
|
||||
Dim sb As StringBuilder
|
||||
Set sb = New StringBuilder
|
||||
Dim rstGoodsUse As New ADODB.Recordset
|
||||
' Debug.Print rstXLS!itsz1,rstXLS!item1
|
||||
strSQL = "Select pno,mtmodel,mtname,mtcolor,wtmodel,wtname,wtcolor,tomeasure" & _
|
||||
" FROM GoodsUse" & _
|
||||
" WHERE corp_use=" & SQLCompany & _
|
||||
" and Depart_Use=(select department from CUSTOMER" & _
|
||||
" where id BETWEEN " & SQLYear & SQLCompany & "0000 AND " & SQLYear & SQLCompany & "9999" & _
|
||||
" limit 1)order by pno"
|
||||
rstGoodsUse.CursorLocation = 3 'mysql RecordCount連線BUG by 藍色小舖 老頑童
|
||||
rstGoodsUse.Open strSQL, Cnmy
|
||||
' Debug.Print rstGoodsUse.RecordCount
|
||||
ItCount = rstGoodsUse.RecordCount '處理項目數
|
||||
sb.Append "insert into SELLUP(id"
|
||||
For i = 1 To ItCount
|
||||
sb.Append "," & "itsz" & i & ",item" & i
|
||||
Next i
|
||||
sb.Append ") VALUES "
|
||||
'資料來源動態設定
|
||||
While Not rstXLS.EOF
|
||||
sb.Append "(" & rstXLS!ID & ","
|
||||
rstGoodsUse.MoveFirst
|
||||
i = 1
|
||||
While Not rstGoodsUse.EOF
|
||||
sb.Append "goodsid('" & rstXLS.Fields.item("itsz" & i) & "'," & IIf(rstXLS!sex, rstGoodsUse!mtmodel, rstGoodsUse!wtmodel) & ")," & _
|
||||
rstXLS.Fields.item("item" & i)
|
||||
i = i + 1
|
||||
rstGoodsUse.MoveNext
|
||||
If Not rstGoodsUse.EOF Then sb.Append ","
|
||||
Wend
|
||||
sb.Append ")"
|
||||
rstXLS.MoveNext
|
||||
If Not rstXLS.EOF Then sb.Append ","
|
||||
Wend
|
||||
sb.Append ";"
|
||||
' Debug.Print sb.tostring
|
||||
Cnmy.Execute sb.ToString
|
||||
rstGoodsUse.Close
|
||||
' 完成資料新增
|
||||
End Sub
|
||||
|
||||
Public Sub XLS_init()
|
||||
' debug.print Worksheets("售價").Cells(3, 11)
|
||||
PYEAR = Worksheets("售價").Cells(3, 11)
|
||||
' debug.print Worksheets("售價").Cells(5, 11)
|
||||
PCOMPANY = Worksheets("售價").Cells(5, 11)
|
||||
' debug.print Worksheets("售價").Cells(7, 11)
|
||||
XLSfile = Worksheets("售價").Cells(7, 11)
|
||||
End Sub
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Reference in new issue
Block a user