【问题标题】:Updating SQL Table via VBA cuts off decimals通过 VBA 更新 SQL 表会截断小数点
【发布时间】:2021-02-05 19:04:45
【问题描述】:

我需要将一组值从 Excel 工作表更新到 SQL Server 表中。 这是 Excel 表:

我在 VBA 中编写了一些代码来执行此操作,但我不是很专业。 更新工作正常,除了截断小数的部分。

如您所见,小数点被截断。 SQL 上的字段声明为十进制 (19,5)。 VBA 代码肯定有问题。这是我的代码。

On Error GoTo RigaErrore

Dim cn_ADO As Object
Dim cmd_ADO As Object

Dim SQLUser As String
Dim SQLPassword As String
Dim SQLServer As String
Dim DBName As String
Dim DBConn As String

Dim SQLQuery As String
Dim strWhere As String


Dim i As Integer
Dim jOffset As Integer
Dim iStartRow As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

    'iStep = 100
jOffset = 20
iStartRow = 3
i = iStartRow

SQLUser = "xxxx"
SQLPassword = "xxx"
SQLServer = "xxxxxxxx"
DBName = "xxxxx"

DBConn = "Provider=SQLOLEDB.1;Pesist Security Info=True;User ID=" & SQLUser & ";Password=" & SQLPassword & ";Initial Catalog=" & DBName & ";" & _
        "Data Source=" & SQLServer & ";DataTypeCompatibility=80;"

Set cn_ADO = CreateObject("ADODB.Connection")
cn_ADO.Open DBConn

Set cmd_ADO = CreateObject("ADODB.Command")

While Cells(i, jOffset).Value <> ""
    xlsIDKey = Cells(i, 0 + jOffset)
    xlsVendSim = CDbl(Cells(i, 1 + jOffset))
    xlsOreSim = CDbl(Cells(i, 2 + jOffset))
    xlsProdVar = CDbl(Cells(i, 3 + jOffset))
    xlsOreSimVar = CDbl(Cells(i, 4 + jOffset))
    
    strWhere = "ID_KEY = '" & xlsIDKey & "'"
    
    SQLQuery = "UPDATE DatiSimulati " & _
                "SET " & _
                "VEND_SIM = Cast(('" & xlsVendSim & "') as decimal (19,5)), " & _
                "ORE_SIM = Cast(('" & xlsOreSim & "') as decimal (19,5)), " & _
                "PROD_VAR = Cast(('" & xlsProdVar & "') as decimal (19,5)), " & _
                "ORE_SIM_VAR = Cast(('" & xlsOreSimVar & "') as decimal (19,5)) " & _
                "WHERE " & strWhere
    
    cmd_ADO.CommandText = SQLQuery
    cmd_ADO.ActiveConnection = cn_ADO
    cmd_ADO.Execute
    
    i = i + 1
Wend

Set cmd_ADO = Nothing
Set cn_ADO = Nothing

Exit Sub

RigaErrore:
MsgBox Err.Number & vbNewLine & Err.Description
Application.StatusBar = False
Application.Cursor = xlDefault

If Not cn_ADO Is Nothing Then
    Set cn_ADO = Nothing
End If
If Not cmd_ADO Is Nothing Then
    Set cmd_ADO = Nothing
End If
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

感谢所有可以帮助解决此问题的人。

【问题讨论】:

  • 会不会是一个简单的 excel 格式问题?尝试手动更改格式中的小数位数,看看是否能看到完整的值。
  • 我将 (1) 检查您的 excel 中的格式 (2) 如果 CDbl 将您的单元格值转换为双精度值,尽管您的本地配置(, 而不是 . )它应该(3)确保xlsVendSimxlsOreSim等尽管是Variant类型不会截断值(您可以将它们声明为Double以确保)

标签: sql excel vba


【解决方案1】:

一种解决方法是用点替换十进制逗号。

Option Explicit

Sub connectDB()

    Const SQLUser = "#"
    Const SQLPassword = "#"
    Const SQLServer = "#"
    Const DBName = "#"
    Dim DBConn As String

    DBConn = "Provider=SQLOLEDB.1;Pesist Security Info=True" & _
             ";User ID=" & SQLUser & ";Password=" & SQLPassword & _
             ";Initial Catalog=" & DBName & _
             ";Data Source=" & SQLServer & _
             ";DataTypeCompatibility=80;"

    Dim cn_ADO As Object, cmd_ADO As Object
    Set cn_ADO = CreateObject("ADODB.Connection")
    
    cn_ADO.Open DBConn
    Set cmd_ADO = CreateObject("ADODB.Command")
    cmd_ADO.ActiveConnection = cn_ADO
  
    Const joffset = 20
    Const iStartRow = 3
    
    Dim SQLQuery As String, sIDKey As String
    Dim sVendSim As String, sOreSim As String
    Dim sProdVar As String, sOreSimVar As String
    Dim i As Long
   
    i = iStartRow
    
    ' create log file
    Dim LOGFILE As String
    LOGFILE = ThisWorkbook.Path & "\logfile.txt"
    Dim fs As Object, ts As Object
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set ts = fs.CreateTextFile(LOGFILE, True)

    While Len(Cells(i, joffset).Value) > 0
    
        sIDKey = Cells(i, 0 + joffset)
        sVendSim = Replace(Cells(i, 1 + joffset), ",", ".")
        sOreSim = Replace(Cells(i, 2 + joffset), ",", ".")
        sProdVar = Replace(Cells(i, 3 + joffset), ",", ".")
        sOreSimVar = Replace(Cells(i, 4 + joffset), ",", ".")
                
        SQLQuery = "UPDATE DatiSimulati " & _
                   "SET " & _
                   "VEND_SIM = " & sVendSim & ", " & _
                   "ORE_SIM = " & sOreSim & ", " & _
                   "PROD_VAR = " & sProdVar & ", " & _
                   "ORE_SIM_VAR = " & sOreSimVar & " " & _
                   "WHERE ID_KEY = " & sIDKey
                   
        ts.writeline SQLQuery & vbCr
        
        cmd_ADO.CommandText = SQLQuery
        cmd_ADO.Execute
        
        i = i + 1
    Wend
    ts.Close
  
    MsgBox i - iStartRow & " records updated see " & LOGFILE, vbInformation

End Sub

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2018-03-17
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多