添加 vbalinkmysql.txt

vbalinkmysql.txt

@@ -0,0 +1,109 @@
+Public conn As ADODB.Connection  '-----定义数据库连接  Public 方便每个SUB使用 不需要重复定义
+Public RES As ADODB.Recordset    '-----定义结果集  结果集和二维表很类似
+Public Sign As String
+Dim row, col As Integer
+Dim Sql As String
+Public Sub closeConn()
+On Error Resume Next
+    If conn Is Nothing Then Exit Sub
+    conn.Close
+    Set conn = Nothing
+End Sub
+
+'----连接数据库
+Public Sub AutoRun()
+    Call closeConn
+   On Error Resume Next
+    Dim strDBinf As String
+    
+    Application.StatusBar = "正在连接数据库……"
+    
+    If conn Is Nothing Then
+        Set conn = New ADODB.Connection
+        Set RES = CreateObject("ADODB.Recordset")
+        
+        strDBinf = "DSN=mysqlinklexcel32"   '标准语句
+        Call conn.Open(strDBinf)
+        
+        If VBA.Err.Number <> 0 Then
+            strDBinf = "DSN=mysqlinklexcel64"   '标准语句
+            VBA.MsgBox "32位DSN连接失败，尝试使用mysqlinklexcel6连接！"
+            Call conn.Open(strDBinf)
+        End If
+       
+        If VBA.Err.Number > 1 Then
+            VBA.MsgBox "连接异常，请检查DB环境！"
+            Set conn = Nothing
+        End If
+        Application.StatusBar = "数据库连接成功"
+    End If
+End Sub
+Sub 拉取电阻信息()
+t = Timer
+
+Application.ScreenUpdating = False
+Application.Calculation = xlCalculationManual
+
+Sql = "SELECT order_no,resistivity, "
+Sql = Sql + "case when resistivity LIKE '&gt;%' then SUBSTRING(resistivity,5,7) "
+Sql = Sql + "    when resistivity LIKE '%~%' then SUBSTRING_INDEX(resistivity,'~',1) "
+Sql = Sql + "    when resistivity LIKE '%-%' then SUBSTRING_INDEX(resistivity,'-',1) "
+Sql = Sql + "    when resistivity LIKE '&lt;%' then SUBSTRING(resistivity,5,7) "
+Sql = Sql + "    when resistivity LIKE '>%' then SUBSTRING(resistivity,2,7) "
+Sql = Sql + "    when resistivity LIKE '<%' then SUBSTRING(resistivity,2,7) "
+Sql = Sql + "    when resistivity = '未分档' OR resistivity IS null then '未分档' end "
+Sql = Sql + " from mes_sync.mes_disposable_qc_task "
+Sql = Sql + " Union "
+Sql = Sql + " SELECT order_no,resistivity, "
+Sql = Sql + " case when resistivity LIKE '&gt;%' then SUBSTRING(resistivity,5,7) "
+Sql = Sql + "     when resistivity LIKE '%~%' then SUBSTRING_INDEX(resistivity,'~',1) "
+Sql = Sql + "     when resistivity LIKE '%-%' then SUBSTRING_INDEX(resistivity,'-',1) "
+Sql = Sql + "     when resistivity LIKE '&lt;%' then SUBSTRING(resistivity,5,7) "
+Sql = Sql + "     when resistivity LIKE '>%' then SUBSTRING(resistivity,2,7) "
+Sql = Sql + "     when resistivity LIKE '<%' then SUBSTRING(resistivity,2,7) "
+Sql = Sql + "     when resistivity = '未分档' OR resistivity IS null then '未分档' end "
+Sql = Sql + "  from mes_sync.mes_recycle_material_storage; "
+
+
+
+Call AutoRun '------获取数据库连接
+
+Application.StatusBar = "正在拉取批次信息"
+RES.Open Sql, conn  '-----执行strSql 获得结果集
+
+Application.StatusBar = "正在复制批次信息到表格"
+Sheets("电阻信息").Cells(2, 1).CopyFromRecordset RES
+
+RES.Close   '-------关闭结果集 必须要做的
+
+Call closeConn
+
+尾行 = Cells(Rows.Count, "A").End(xlUp).row
+
+Application.StatusBar = "正在判断高低阻信息"
+For i = 2 To 尾行
+    电阻 = Sheets("电阻信息").Cells(i, 3).Value
+    On Error Resume Next
+    
+    If 电阻 = "未分档" Then
+        Sheets("电阻信息").Cells(i, 4).Value = "低阻"
+    Else
+    If 电阻 >= 1.9 Then
+        Sheets("电阻信息").Cells(i, 4).Value = "高阻"
+    Else: Sheets("电阻信息").Cells(i, 4).Value = "低阻"
+    End If
+    End If
+Next
+
+
+
+Application.ScreenUpdating = True
+Application.Calculation = xlCalculationAutomatic
+
+Application.StatusBar = "拉取完成"
+
+MsgBox ("本次更新共花费:" & Format(Timer - t, "0.00") & "s!")
+Application.StatusBar = False
+End Sub
+
+