Импорт Excel в Access с пользовательским динамическим диапазоном

Question

У меня есть некоторые проблемы при получении моего импорта работать:

Function importMetrics() 
Dim strFile As String 
Dim strPath As String 
Dim strWorksheet As String 
Dim strTable As String 

'Excel variables 
Dim xlApp As Excel.Application 
Dim xlFile As Excel.Workbook 
Dim xlSheet As Excel.Worksheet 
Dim xlRange1 As Excel.Range 
Dim xlRange2 As Excel.Range 

Dim r1, r2 As String 
Dim r#, c# 
Dim clVal As String 

'Set File Path 
strPath = CurrentProject.Path & "\Data\2015\01 - January" 

'check if directory exists 
If Len(Dir(strPath, vbDirectory)) = 0 Then 
    MsgBox ("File Doesn't exist") 
    End 
End If 

'Import all Files 
strFile = Dir(strPath & "\*.xl*") 

'ID which Sheet to Import 
strWorksheet = "EP & NBO DATA" 

'ID Table to Import To 
strTable = "tbl_MIPData" 

'start loop 
Do While strFile <> "" 
    'Open File 
    'Get the info from Excel: 
    Set xlApp = New Excel.Application 

    Set xlFile = xlApp.Workbooks.Open(strPath & "\" & strFile, False, True) 

    Set xlSheet = xlFile.Sheets(strWorksheet) 

    Set xlRange1 = xlSheet.Range("A1" & xlSheet.Range("A1").End(xlDown).End(xlToRight)).Select 
    Set xlRange2 = xlSheet.Range("N1" & xlSheet.Range("N1").End(xlDown).End(xlToRight)).Select 

    'Import File Range A 

    DoCmd.TransferSpreadsheet _ 
     transfertype:=acImport, _ 
     tablename:=strTable, _ 
     FileName:=strPath & "\" & strFile, _ 
     hasFieldNames:=False, _ 
     Range:=xlRange1 

    'Import File Range B 
    DoCmd.TransferSpreadsheet _ 
     transfertype:=acImport, _ 
     tablename:=strTable, _ 
     FileName:=strPath & strFile, _ 
     hasFieldNames:=False, _ 
     Range:=strWorksheet & "!" & xlRange2 

     'Close Excel File 
     xlApp.Quit 
     Set xlApp = Nothing 
Loop 

End Function 

Это код, который я написал до сих пор. Я думаю, что это связано с тем, как я открываю файлы Excel. Диапазон выходит из строя на xlRange1 и xlRange2. Если я поставлю xlSheet.Select, он, похоже, не исправит его.

Я нахожусь в этом состоянии. Кроме того, я не мог много узнать о том, как рекурсивно ходить в подкаталогах (например, перемещать все файлы Excel в данных)

Доступ к 2010 году с файлами XLSX Excel 2010.

Answer 1

• TransferSpreadsheet Method [Access 2003 VBA Language Reference]

  ДиапазонДополнительный вариант. A строка выражение, которое является допустимым диапазоном ячеек, или имя диапазона в электронной таблице. Этот аргумент применяется только к импорту. Оставьте этот аргумент пустым, чтобы импортировать всю электронную таблицу.

Как и выше, вам нужно, чтобы диапазон был как B2:F10, а не синтаксический анализ объекта Range.

Таким образом, вы можете использовать Address свойство ваших диапазонов, как:

Range:=xlRange1.Address 

Я не могу проверить это.

Answer 2

Вы пытаетесь импортировать данные, пока файл открыт, что даст вам некоторые проблемы. Что вы хотите сделать, это открыть файл excel, установить диапазоны, сохранить книгу, импортировать диапазоны, затем вернуться и очистить именованные диапазоны, если вы этого пожелаете.

Если вы импортируете два отдельных набора данных, хранящихся на одном листе, вы можете захотеть разделить их на два отдельных листа, чтобы сделать вашу жизнь намного проще.

В настоящее время, что-то типа;

Do While strFile <> "" 
'Open File 
'Get the info from Excel: 
Set xlApp = New Excel.Application 

Set xlFile = xlApp.Workbooks.Open(strPath & "\" & strFile, False, True) 

Set xlSheet = xlFile.Sheets(strWorksheet) 

легче использовать переменную, чтобы захватить вашу последнюю использованную строку , такие как

dim lastRow as integer 
lastrow = xlSheet.Range("A1").End(xlDown) 'set the value of our last used row 
xlSheet.Range("A1:M" & lastRow & "").name = "xlRange1" 'apply a name to our range 
lastrow = xlSheet.Range("n1").End(xlDown) 'reset our last row value 
xlSheet.Range("N1:'enterlastcolumnhere'" & lastRow & "").name = "xlRange2" 

xlFile.save 'save our named ranges 
xlApp.Quit 'close off 
Set xlApp = Nothing 



'Import File Range A 

DoCmd.TransferSpreadsheet _ 
    transfertype:=acImport, _ 
    tablename:=strTable, _ 
    FileName:=strPath & "\" & strFile, _ 
    hasFieldNames:=False, _ 
    Range:="xlRange1" 'this should now work if we didn't get any errors when setting the named ranges 

'Import File Range B 
DoCmd.TransferSpreadsheet _ 
    transfertype:=acImport, _ 
    tablename:=strTable, _ 
    FileName:=strPath & strFile, _ 
    hasFieldNames:=False, _ 
    Range:="xlRange2" 

Loop

End Function

Я написал изменения кода из памяти, но это должен поставить вас на правильный путь, если вы все еще застряли с ним, дайте мне знать, что я могу выкупить предыдущий пример, который я написал для вас! HTH