Here is an example of creating a database and writing to the database. I'm
using a Access Database but you just need to change the connection string to
the SQL server.
I had coded the field names below but you can make a change like this to
make it variable
from
With rs
.AddNew
![Client Name] = ClientName
end with
to
Myfiled = "abc"
With rs
.AddNew
rs(Client Name) = ClientName
end with
the looping through te sheets would look like this
with rs
for each sht in sheets
'put code here to move data from worksheet to database
next sht
end with
You didn't provided enough info for my to specify what you need for the
filtering. I can modify any of this code as required. Just provide more
details.
------------------------------------------------------------------------------------------
Public Const Folder = "C:\Temp\"
Public Const FName = "submission.mdb"
Sub MakeDataBase()
Const DB_Text As Long = 10
Const FldLen As Integer = 40
strDB = Folder & FName
If Dir(strDB) <> "" Then
MsgBox ("Database Exists - Exit Macro : " & strDB)
Exit Sub
End If
' Create new instance of Microsoft Access.
Set appAccess = CreateObject("Access.Application")
appAccess.Visible = True
' Open database in Microsoft Access window.
appAccess.NewCurrentDatabase strDB
' Get Database object variable.
Set dbs = appAccess.CurrentDb
' Create new table.
Set tdf = dbs.CreateTableDef("Submissions")
' Create Task/ID field in new table.
Set fld = tdf. _
CreateField("Task_ID", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld
' Create Client Name field in new table.
Set fld = tdf. _
CreateField("Client Name", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld
' Create Effective Date field in new table.
Set fld = tdf. _
CreateField("Effective Date", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld
' Create Imp Mgr field in new table.
Set fld = tdf. _
CreateField("Imp Mgr", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld
' Create Due Date field in new table.
Set fld = tdf. _
CreateField("Due Date", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld
' Create Actual Date field in new table.
Set fld = tdf. _
CreateField("Actual Date", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld
' Create Date Difference field in new table.
Set fld = tdf. _
CreateField("Date Difference", DB_Text, FldLen)
' Append Field and TableDef objects.
tdf.Fields.Append fld
dbs.TableDefs.Append tdf
Set appAccess = Nothing
End Sub
-------------------------------------------------------------------------------------
Sub Submit()
'filename of database is with MakeDatabase macro
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
strDB = Folder & FName
If Dir(strDB) = "" Then
MsgBox ("Database Doesn't Exists, Create Database" & strDB)
MsgBox ("Exiting Macro")
Exit Sub
End If
ConnectStr = _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & Folder & FName & ";" & _
"Mode=Share Deny None;"
cn.Open (ConnectStr)
With rs
.Open Source:="Submissions", _
ActiveConnection:=cn, _
CursorType:=adOpenDynamic, _
LockType:=adLockOptimistic, _
Options:=adCmdTable
If .EOF <> True Then
.MoveLast
End If
End With
With Sheets("Internal Project Plan")
ClientName = .Range("B4")
ImpMgr = .Range("B5")
LaunchDate = .Range("C4")
LastRow = .Range("K" & Rows.Count).End(xlUp).Row
For RowCount = 7 To LastRow
If UCase(.Range("K" & RowCount)) = "X" Then
DueDate = .Range("E" & RowCount)
ActualDate = .Range("F" & RowCount)
DateDif = .Range("M" & RowCount)
Accurate = .Range("L" & RowCount)
Task_ID = .Range("B" & RowCount)
With rs
.AddNew
!Task_ID = Task_ID
![Client Name] = ClientName
![Effective Date] = LaunchDate
![Imp Mgr] = ImpMgr
![Due Date] = DueDate
![Actual Date] = ActualDate
![Date Difference] = DateDif
.Update
End With
End If
Next RowCount
End With
Set appAccess = Nothing
End Sub
---------------------------------------------------------------------------------------
