Как мне предложить пользователю выбрать файл при использовании макроса для импорта файла данных в новую вкладку? - PullRequest
Новая
       10

Как мне предложить пользователю выбрать файл при использовании макроса для импорта файла данных в новую вкладку?

2 голосов
/ 06 апреля 2011

У меня есть макрос, который в настоящее время создает новый лист и импортирует другой файл Excel в этот новый лист.

Данные с этого листа переносятся в другие области рабочей книги.

Импортируемый файл постоянно будет иметь другое имя.Как настроить приведенный ниже код, чтобы пользователь мог выбрать файл?(Каталог не изменится).

Sub ImportDemand () Sheets.Add 

Sheets(2).Select
Sheets(2).Name = "ImportedDemand"
Range("E42").Select
With ActiveSheet.QueryTables.Add(Connection:=Array( _
    "OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=\\Folder\ImportFile_2011.04.05.xls;Mode=Share Deny Write;Extended Properties=""HDR=YES;"";Jet OLEDB:System d" _
    , _
    "atabase="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=35;Jet OLEDB:Database Locking Mode=0;" _
    , _
    "Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create Sys" _
    , _
    "tem Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Repli" _
    , "ca Repair=False;Jet OLEDB:SFP=False"), Destination:=Range("A1"))
    .CommandType = xlCmdTable
    .CommandText = Array("_All_Demand$")
    .Name = "ImportFile_2011.04.05"
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .BackgroundQuery = True
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .PreserveColumnInfo = True
    .SourceDataFile = _
    "\\Folder\ImportFile_2011.04.05.xls"
    .Refresh BackgroundQuery:=False
End With

End Sub

1 Ответ

4 голосов
/ 06 апреля 2011

Вы можете использовать GetOpenFilename: 

.SourceDataFile = Application.GetOpenFilename("Excel workbooks (*.xls), *.xls")

Другим вариантом является объект FileDialog.Это предлагает больше гибкости. 

Dim fdgOpen As FileDialog
Set fdgOpen = Application.FileDialog(msoFileDialogOpen)
fdgOpen.Title = "Please open a data file..."
fdgOpen.InitialFileName = "C:\MyDocuments\MyDir\"
'Other settings...
fdgOpen.Show
.SourceDataFile = fdgOpen.SelectedItems(1)
...