Code:
Option Explicit
Private Cn As Object 'ADODB.Connection
Private RS As Object 'ADODB.Recordset
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Const connString As String = _
"Driver={SQL Server};" & _
"Server=<server>;" & _
"Database=<database>;" & _
"Uid=<user>;" & _
"Pwd=<password>;"
Dim CurrMonth As String, PrevMonth As String
Dim ServerName As String
Dim DatabaseName As String
Dim TableName As String
Dim UserID As String
Dim Password As String
Dim Msg As String
Msg = MsgBox("Do you really want to save the workbook?", vbYesNo)
If Msg = vbYes Then
ServerName = "."
DatabaseName = "Upload"
TableName = "Test"
UserID = ""
Password = ""
Set Cn = CreateObject("ADODB.Connection")
With Cn
.CursorLocation = 3 'adUseClient
.Open Replace(Replace(Replace(Replace(connString, _
"<server>", ServerName), _
"<database>", DatabaseName), _
"<user>", UserID), _
"Password>", Password)
.CommandTimeout = 0
End With
CurrMonth = Format$(Date, "mmm 'yy")
PrevMonth = Format$(Date - Day(Date), "mmm 'yy")
Call upload(Worksheets(PrevMonth))
Call upload(Worksheets(CurrMonth))
Cn.Close
Set Cn = Nothing
Else
MsgBox "Operation was Cancelled"
End If
End Sub
Sub upload(ByRef sh As Worksheet)
Const sSQLSelect As String = _
"SELECT Count( ID ) " & vbNewLine & _
"FROM Test " & vbNewLine & _
"WHERE Country='<country>' AND " & vbNewLine & _
" Name='<name>'"
Const sSQLInsert As String = _
"INSERT INTO Test(Country" & vbNewLine & _
" ,Name" & vbNewLine & _
" ,Month" & vbNewLine & _
" ,Year) " & vbNewLine & _
"VALUES ('<country>'" & vbNewLine & _
" ,'<name>'" & vbNewLine & _
" ,'<month>'" & vbNewLine & _
" ,'<year>')"
Const sSQLUpdate As String = _
"UPDATE Test " & vbNewLine & _
"SET Month = '<month>'" & vbNewLine & _
" ,Year = '<year>'" & vbNewLine & _
" ,Name = '<name>'" & vbNewLine & _
"WHERE Country = '<country>'"
Dim shtSheetToWork As Worksheet
Dim lRow As Long, lCol As Long
Dim sSQL As String
Dim SplitMonthYear As String
Dim SplitMonth As String
Dim SplitYear As String
Dim SqlRowCount
Dim LastRow As Long
Dim mtxRecords As Variant
With sh
SplitMonthYear = .Name
SplitMonth = Left(SplitMonthYear, 3)
SplitYear = "20" & "" & Right(SplitMonthYear, 2)
Set RS = CreateObject("ADODB.RecordSet")
LastRow = .Cells(.Rows.Count, "A").End(xlUp).row
For lRow = 2 To LastRow
sSQL = Replace(Replace(sSQLSelect, _
"<country>", .Cells(lRow, "B").Value), _
"<name>", .Cells(lRow, "C").Value)
RS.Open sSQL, Cn, 2, 3 'adOpenDynamic, adLockOptimistic
mtxRecords = RS.GetRows
If mtxRecords(0, 0) = 0 Then
sSQL = Replace(Replace(Replace(Replace(sSQLInsert, _
"<country>", .Cells(lRow, "B").Value), _
"<name>", .Cells(lRow, "C").Value), _
"<month>", SplitMonth), _
"<year>", SplitYear)
Cn.Execute sSQL
Else
sSQL = Replace(Replace(Replace(Replace(sSQLUpdate, _
"<country>", .Cells(lRow, "B").Value), _
"<name>", .Cells(lRow, "C").Value), _
"<month>", SplitMonth), _
"<year>", SplitYear)
Cn.Execute sSQL
End If
RS.Close
Next lRow
End With
End Sub
Bookmarks