Private Sub UserForm_Activate()
Dim cnt As New ADODB.Connection
Dim rst As New ADODB.Recordset
cnt.Open "Provider=Microsoft.Ace.OLEDB.12.0; Persist Security Info = False;" & _
"Data Source=C:\YourFolder\YourDataBase.accdb;"
rst.Open "TableToBeOpened", cnt, adOpenKeyset, adLockOptimistic, adCmdTable
With rst
Debug.Print rst.RecordCount
End With
Dim RangeOfCellsToBEAddedToTable As Range
Set RangeOfCellsToBEAddedToTable= Sheets(1).Range("a1", Range("a65000").End(xlUp))
For Each el In RangeOfCellsToBEAddedToTable
Debug.Print el
With rst
.AddNew
.Fields("1NameOFFiledInTable") = el
.Fields("2NameOFFiledInTable") = Date
.Update
End With
Next
With rst
.Close
End With
rst.Open "Select * From TableToBeOpened;", cnt
Sheets(1).Range("a1").CurrentRegion.ClearContents
Sheets(1).Range("A1").CopyFromRecordset rst
rst.Close
rst.Open "DELETE FROM TableToBeOpenedWHERE 2NameOFFiledInTable=date()-1;", cnt
rst.Open "Select * From TableToBeOpenedWHERE ;", cnt
Sheets(1).Range("a1").CurrentRegion.ClearContents
Sheets(1).Range("A1").CopyFromRecordset rst
rst.Close
cnt.Close
End Sub
@@@@@@@@@@@@@@
Const CONN_STR = "Provider = sqloledb; Data Source=123.45.6.79\\YourFolder,1433;Initial Catalog=guardian;User ID=YourId;Password=YourPassword"
Sub ImportData()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Set rs = New ADODB.Recordset
On Error GoTo ErrorHandler
cn.ConnectionString = CONN_STR
cn.Open
Dim sSql As String
sSql = "SELECT * FROM YourTable"
rs.Open sSql, cn
Dim ws As Worksheet
Set ws = Application.Sheets.Add
ws.Range("A1").CopyFromRecordset rs
Clearing:
On Error Resume Next
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
Exit Sub
ErrorHandler:
MsgBox Err.Description
Resume Clearing
End Sub
@@@@@@@@@@@@@@@@@@@@@@@@@@@ FROM SAP
Dim SAPFunc, F2 As Object
Sub sapData()
Dim Login As String
Dim password As String
Dim eNR As String
Dim eYEAR As String
Login = "YourLogin"
password = "YourPassword"
eNR = "12333" ' forexample - value od field to be found
eYEAR= "2014" ' ' forexample - value od field to be found
Dim tblFields As Object
Set SAPFunc = CreateObject("SAP.Functions")
If Not setConnection(Login, password) Then
FillRow = False
Exit Sub
End If
Set F2 = SAPFunc.Add("NameOfReport")
F2.exports("FLAG") = "E"
F2.exports("NR") = eNR
F2.exports("YEAR") = eYEAR
If Not F2.call Then
FillRow = False
Exit Sub
End If
On Error Resume Next
Set Cust = F2.Tables("NameOfTable")
Set tblFields = RfcCallTransaction.Tables("NameOfTable")
Debug.Print Cust(1, "NameOfField1")
Debug.Print Cust(1, "NameOfField2")
Debug.Print RfcCallTransaction.Tables("NameOfTable")
dropConnection
End Sub
Private Function setConnection(RFCuser, password) As Boolean
setConnection = True
SAPFunc.Connection.client = "001"
SAPFunc.Connection.User = RFCuser
SAPFunc.Connection.password = password
SAPFunc.Connection.Language = "DE"
SAPFunc.Connection.hostname = "123.45.6.789"
SAPFunc.Connection.SystemNumber = "02"
SAPFunc.Connection.System = "PRO"
SAPFunc.Connection.messageserver = ""
SAPFunc.Connection.groupname = ""
If SAPFunc.Connection.Logon(0, True) = False Then
MsgBox "Invalid logon"
setConnection = False
End If
End Function
Private Sub dropConnection()
If Not SAPFunc Is Nothing Then SAPFunc.Connection.Logoff
End Sub