vba do excel para o access com determinados critérios

Gostaria de criar um access vba que importa dados do excel. Dado que estou apenas iniciando na programação vba eu sou apenas capaz de peça vários códigos juntos para tornar o código final. Eu pesquisei um pouco, mas não encontrei nada que trabalha para mim. Eu farei o meu melhor para explicar as condições que eu tenho.

O acesso de banco de dados deve conter o código do vba. Ele tem um par de tabelas, cada uma tem as chaves primárias geradas pelo acesso. A tabela de nomes contêm espaços, para eu ter "01 Cutlist", "04 Panel_Data" e "08 Pallets". Eu preciso os dados importados a partir de dois livros diferentes, significando que as duas primeiras tabelas de obter os dados a partir de uma pasta de trabalho enquanto o último irá obter os dados a partir de outro. Os dados no excel são colocados na mesma ordem da tabela do access, exceto para a chave primária. O Excel não tem uma coluna de chave primária. Os dados do excel começa na célula A7, A10 e A5, respectivamente. Outro problema é que os cabeçalhos de coluna no excel não corresponder sempre o acesso cabeçalhos de tabela

Eu tive algum sucesso usando o código de http://www.accessmvp.com/KDSnell/EXCEL_Import.htm. Mas o meu código está sempre a bloquear. A seguir é o código que eu até agora

Sub E2A()
Dim xlx As Object, xlw As Object
Dim blnEXCEL As Boolean
blnEXCEL = False

On Error Resume Next
Set xlx = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
      Set xlx = CreateObject("Excel.Application")
      blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

xTab = "Step 1 - Cutlist"
aTab = "01 Cutlist"
sCell = "A7"
oFile = "_cutlist.xlsx"
a = E2A_Loop(xlx, xlw, xTab, aTab, sCell, oFile)

xTab = "Step 4 - Panel Mass"
aTab = "04 Panel_Data"
sCell = "A10"
oFile = "_cutlist.xlsx"
a = E2A_Loop(xlx, xlw, xTab, aTab, sCell, oFile)
If blnEXCEL = True Then xlx.Quit
Set xlx = Nothing
End Sub

Function E2A_Loop(xlx, xlw, xTab, aTab, sCell, oFile)
Dim lngColumn As Long
Dim xls As Object, xlc As Object
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim blnEXCEL As Boolean
blnEXCEL = False

xlx.Application.ScreenUpdating = False
xlx.Visible = False
Set dbs = CurrentDb()
Set xlw = xlx.Workbooks.Open(CurrentProject.Path & "\" & Left(Application.CurrentProject.Name, 6) & oFile, , True) ' opens in read-only mode
Set xls = xlw.Worksheets(xTab)
Set xlc = xls.Range(sCell) ' this is the first cell that contains data

'Delete all records
strSQL = "Delete * From [" & aTab & "]"
dbs.Execute (strSQL)

Set rst = dbs.OpenRecordset(aTab, dbOpenDynaset, dbAppendOnly)

' write data to the recordset
Do While xlc.Value <> ""
      rst.AddNew
            For lngColumn = 0 To rst.Fields.Count - 2
                rst.Fields(lngColumn + 1).Value = xlc.Offset(0, lngColumn).Value
            Next lngColumn
      rst.Update
      Set xlc = xlc.Offset(1, 0)
Loop

rst.Close
Set rst = Nothing

dbs.Close
Set dbs = Nothing

' Close the EXCEL file without saving the file, and clean up the EXCEL objects
Set xlc = Nothing
Set xls = Nothing
xlw.Close False
Set xlw = Nothing

End Function
0
2019-09-18 06:38:55
origem
0 respostas

Veja mais perguntas por marcas