如何直接訪問文件夾和訪問Excel文件

Question

我有一個名爲「原始數據」的文件夾，並有幾個Excel文件名，擴展名爲.xlsx 我有另一個啓用了宏的Excel文件作爲「Test.xlsm」。

現在，我有一個宏，以這樣的方式工作，它進入本地目錄，然後打開Excel文件。當我改變我的文件夾時，這對我來說是不可行的。

是否有可能，我可以有一個代碼，以這種方式，它只是尋找文件夾「原始數據」。並打開我提到的文件。

我不知道如何做到這一點。任何潛在客戶都會有幫助。

現在我有下面的代碼工作。 （不過，這看起來從一個驅動器位置d的原始數據「）

Private Sub CommandButton11_Click() 
Dim filename As String 

Workbooks.Open ("D:\Jenny\Raw data\Result.xlsx") 

filename = ActiveWorkbook.Path & "\Result.xlsx" 

End Sub 

Answer 1

假設用戶知道在哪裏的文件夾，只是提示輸入：

Dim fldr$ 
Dim fdlg As FileDialog 
Set fdlg = Application.FileDialog(msoFileDialogFolderPicker) 
fdlg.Show 

If fdlg.SelectedItems.Count <> 0 Then 
    fldr = fdlg.SelectedItems(1) 
Else: 
    Exit Sub 
End If 

Dim wb as Workbook 
Set wb = Workbooks.Open(fldr & Application.PathSeparator & "Results.xlsx") 

當然，你應該有錯誤 - 在辦案的文件沒有在文件夾中存在用戶選擇，等等

或者使用Application.FileDialog(msoFileDialogFilePicker)來提示用戶定位手動文件。應用程序無法以其他方式知道的文件可能存在 - 他們可能在任何地方，或者他們甚至可能不存在於用戶可以訪問的位置。

Dim resultsBook as Workbook 
Dim testBook as Workbook 
Dim fdlg as FileDialog 
Set fdlg = Application.FileDialg(msoFileDialogFilePicker) 
MsgBOx "Select the Results file" 
fdlg.Show 
If fdlg.SelectedItems.Count <> 0 Then 
    Set resultsBook = Workbooks.Open(fdlg.SelectedItems(1)) 
Else: 
    Exit Sub 
End If 
MsgBox "Select the Test file" 
fdlg.Show 
    If fdlg.SelectedItems.Count <> 0 Then 
    Set testBook = Workbooks.Open(fdlg.SelectedItems(1)) 
Else: 
    Exit Sub 
End If 

Answer 2

使用CreateObject("Shell.Application")

Sub tst() 

    Dim oShell As Object 
    Dim sFolderPath As String 

    Set oShell = CreateObject("Shell.Application").BrowseForFolder(0, "Please choose a folder", 0) 
    If oShell Is Nothing Then Exit Sub 'Pressed cancel 

    sFolderPath = oShell.Self.Path & Application.PathSeparator 

    MsgBox sFolderPath 
    'Workbooks.Open sFolderPath & "Result.xlsx" 

End Sub 

Answer 3

這聽起來像您要重，可能移動的原始數據文件夾，而不是「破發」的宏觀能力的另一種方法。如果是這種情況，請將Test.xlsm文件保存在原始數據文件夾中。

然後做一些像這樣的循環打開&處理文件夾中的每個XLSX原始數據文件。我的代碼是userFiles /你可能是rawDataFiles或其他東西。

userFilesPath = ThisWorkbook.Path 
userFileName = Dir(userFilesPath & "*.xlsx", vbNormal) 

Do While userFileName <> "" 
    On Error Resume Next 
    userFile = userFilesPath & userFileName 

    ' this is the raw data file 
    On Error Resume Next 
    Set uf = Workbooks.Open(Filename:=userFile, UpdateLinks:=False, ReadOnly:=True) 

    ' do some stuff with the raw data 
    On Error Resume Next 
    For Each s In uf.Sheets 
     If Len(s.Range("a1").Value) > 1 Then 
      s.Range("a1:z" & s.Range("a1000000").End(xlUp).Row).Copy 
      ws.Range("a" & ws.Range("a1000000").End(xlUp).Row + 1).PasteSpecial xlPasteValues 
     End If 
     Application.CutCopyMode = False 
    Next 
    uf.Close False 

    userFileName = Dir 
Loop