From 782cddb18b1698b6b8082dcd6726a324beaa73b0 Mon Sep 17 00:00:00 2001 From: xiaochou164 Date: Tue, 15 Aug 2023 11:10:31 +0000 Subject: [PATCH] =?UTF-8?q?=E5=88=A0=E9=99=A4=20vbalinkmysql.txt?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- vbalinkmysql.txt | 109 ----------------------------------------------- 1 file changed, 109 deletions(-) delete mode 100644 vbalinkmysql.txt diff --git a/vbalinkmysql.txt b/vbalinkmysql.txt deleted file mode 100644 index ffbd5ce..0000000 --- a/vbalinkmysql.txt +++ /dev/null @@ -1,109 +0,0 @@ -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连接失败,尝试使用mysqllinkexcel6连接!" - 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 '>%' 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 '<%' 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 '>%' 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 '<%' 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 - -