Eksporter fra Excel til Access

Lidt hen ad...
http://www.exceltip.com/st/Export_data_from_Excel_to_Access_(ADO)_using_VBA_in_Microsoft_Excel/425.html

Og selvfølgelig i samme ombæring, om man i VBA'en kan fortælle at connectionen til SQL Server tabellerne skal benytte Integrated Security...

Jeg kender ikke noget til SQL server Backend, men i ren Access kan du sammenkæde dit Excel ark til Access i menuen Filer > Hent eksterne data > Sammenkæd. Så bliver Excel arket indsat som en tabel i Access med kæde til Excel, så Access hele tiden er opdasteret. Om det er en option i dit tilfælde ved jeg ikke.

Private Sub DataImport_Click()
Dim a As String
On Error GoTo err_dataimport
Me.DataImport.HyperlinkAddress = LaunchCD(Me)
Me.Tekst24 = Me.DataImport.HyperlinkAddress 'Dette tekstfelt viser stien
a = Me.Tekst24
DoCmd.TransferSpreadsheet acImport, 0, "tblTemp", a, True, ""
DoCmd.SetWarnings False

Her kan du så køre dine query's så du får flyttet data og slettet tblTemp.

DoCmd.SetWarnings True
MsgBox "Følgende data er importeret"
err_dataimport:
Exit Sub
End Sub

Tilhørende modul:

Option Compare Database
Option Explicit
Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As Long
hwndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
Flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As Long
lpfnHook As Long
lpTemplateName As String
End Type
Function LaunchCD(strform As Form) As String
Dim OpenFile As OPENFILENAME
Dim lReturn As Long
Dim sFilter As String
OpenFile.lStructSize = Len(OpenFile)
OpenFile.hwndOwner = strform.hwnd
sFilter = "All Files (*.*)" & Chr(0) & "*.*" & Chr(0) & _
"JPG Files (*.JPG)" & Chr(0) & "*.JPG" & Chr(0)
OpenFile.lpstrFilter = sFilter
OpenFile.nFilterIndex = 1
OpenFile.lpstrFile = String(257, 0)
OpenFile.nMaxFile = Len(OpenFile.lpstrFile) - 1
OpenFile.lpstrFileTitle = OpenFile.lpstrFile
OpenFile.nMaxFileTitle = OpenFile.nMaxFile
OpenFile.lpstrInitialDir = "C:\Billede"
OpenFile.lpstrTitle = "Vælg en fil og tryk på Åbn."
OpenFile.Flags = 0
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
MsgBox "Manglende fil!", vbInformation, _
"Du har ikke valgt en fil fra Stifinderen."
Else
LaunchCD = Trim(OpenFile.lpstrFile)
End If
End Function

Håber det lykkedes!~)

Hmmm....det var en ordentlig smøre, spg!
Mugs, desværre, der kan være tale om flere regneark, så det SKAL pushes fra Excel til Access.

Jeg fandt dog selv på en løsning.

Sub EksporterDataTilSQLServer()

  Dim cn As ADODB.Connection, rs As ADODB.Recordset, r As Long
  Set cn = New ADODB.Connection
  cn.Open "Provider=sqloledb;Data Source=MyServer;Initial Catalog=MyDatabase;Integrated Security=SSPI"
  Set rs = New ADODB.Recordset
  rs.Open "MyTable", cn, adOpenKeyset, adLockOptimistic, adCmdTable
   
  With rs
    .AddNew
    .Fields("Dato") = Range("Dato").Value
    .Fields("Tidspunkt") = Range("Tidspunkt").Value
    .
    .
    .
    .
    .
    .Fields("Bemaerkninger") = Range("Bemaerkninger").Value
    .Update
  End With
 
  rs.Close
  Set rs = Nothing
  cn.Close
  Set cn = Nothing
End Sub

Så overføres de felter jeg vil have, no problem!