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 '&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