SQL / VBA

excel vba INSSQL UPSQL

開發一次,受用一生,使用EXCEL來異動SQL的好東西

'SET SCAN OFF

Public Function INSSQL(tableName, thRow, range)
    insTH = ""
    For Each l_cell In range
        insTH = insTH & "," & Cells(thRow, l_cell.Column).Value
    Next
    insTH = Mid(insTH, 2)
    insTH = "(" & insTH & ")"

    insTD = ""
    For Each l_cell In range
        If TypeName(l_cell.Value) = "String" Or TypeName(l_cell.Value) = "Date" Or l_cell.Value = "" Or l_cell.NumberFormatLocal = "@" Then
            If l_cell.Value = "" And Cells(thRow, l_cell.Column).Interior.ColorIndex = 2 Then
                insTD = insTD & ",' '"
            Else
                insTD = insTD & ",'" & l_cell.Value & "'"
            End If
        Else
            insTD = insTD & "," & l_cell.Value
        End If
    Next
    insTD = Mid(insTD, 2)
    insTD = "(" & insTD & ");"
    
    INSSQL = "INSERT INTO " & tableName & " " & insTH & "VALUES" & insTD
End Function

Public Function UPSQL(tableName, thRow, setRange, whereRange)
    
    setString = ""
    For Each l_cell In setRange
        If TypeName(l_cell.Value) = "String" Or TypeName(l_cell.Value) = "Date" Or l_cell.Value = "" Or l_cell.NumberFormatLocal = "@" Then
            If l_cell.Value = "" And Cells(thRow, l_cell.Column).Interior.ColorIndex = 2 Then
                setString = setString & "," & Cells(thRow, l_cell.Column).Value & "=' '"
            Else
                setString = setString & "," & Cells(thRow, l_cell.Column).Value & "='" & l_cell.Value & "'"
            End If
        Else
            setString = setString & "," & Cells(thRow, l_cell.Column).Value & "=" & l_cell.Value
        End If
    Next
    setString = Mid(setString, 2)

    whereString = ""
    For Each l_cell In whereRange
        If TypeName(l_cell.Value) = "String" Or TypeName(l_cell.Value) = "Date" Or l_cell.Value = "" Or l_cell.NumberFormatLocal = "@" Then
            If l_cell.Value = "" And Cells(thRow, l_cell.Column).Interior.ColorIndex = 2 Then
                whereString = whereString & " AND " & Cells(thRow, l_cell.Column).Value & "=' '"
            Else
                whereString = whereString & " AND " & Cells(thRow, l_cell.Column).Value & "='" & l_cell.Value & "'"
            End If
        Else
            whereString = whereString & " AND " & Cells(thRow, l_cell.Column).Value & "=" & l_cell.Value
        End If
    Next
     whereString = Mid(whereString, 6)

    UPSQL = "UPDATE " & tableName & " SET " & setString & " WHERE " & whereString & ";"
    
End Function

發佈留言

發佈留言必須填寫的電子郵件地址不會公開。