使用VBA打開文件夾中的文件

Question

我想點擊按鈕后自動打開文件，每個月文件夾相同，文件名相同。 我希望它總是 select 來自 teog msc 的最新文件，例如，如果不是，它會說文件太舊。 但是，我現在收到錯誤消息 Object Variable or With Block not Set。 這里data_wb.Sheets("Adekwatnosc").Rows("1:1").Select這段代碼就像一個想要創建的。自動打開我的文件

   ThisMonth = Format(Date, "mmmm")
   MyFolder = "C:\Users\V1410191\Documents\Final" & ThisMonth & ""
   MyFile = Dir(MyFolder & "\FinalPrice*.xlsm")
   Do Until MyFile = ""
   MyFile = Dir
Set data_wb = Workbooks.Open(MyFile, UpdateLinks:=0)

Loop

這是我的代碼。

Dim vDate As Date
Dim wbMe As Workbook
Dim data_wb As Workbook
Dim ws As Worksheet
Dim inputbx As String
Dim loc As Range, lc As Long
Dim MyFolder As String, ThisMonth As String
Dim MyFile As String

'Set workbook'

Set wbMe = ActiveWorkbook
With wbMe.Sheets("input_forecast").Rows("1:1")
    .Copy
    .PasteSpecial Paste:=xlPasteValues
    .NumberFormat = "YYYY-MM-DD"
  End With
  
Application.ThisWorkbook.UpdateLinks = xlUpdateLinksNever '2
Application.DisplayAlerts = False
  
file_name = selectFilePK
If file_name = "" Then Exit Sub
Set data_wb = Workbooks.Open(file_name)


   'paste copy like value and change to date format'
   data_wb.Sheets("Adekwatnosc").Rows("1:1").Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.NumberFormat = "YYYY-MM-DD"
 
 Do
        inputbx = InputBox("Enter Date, FORMAT; YYYY-MM-DD", , Format(VBA.Now, "YYYY-MM-DD"))
        If inputbx = vbNullString Then Exit Sub
        On Error Resume Next
        vDate = DateValue(inputbx)
        On Error GoTo 0
        DateIsValid = IsDate(vDate)
        If Not DateIsValid Then MsgBox "Please enter a valid date.", vbExclamation
    Loop Until DateIsValid
       

     

     data_wb.Worksheets("Adekwatnosc").Activate
     With data_wb.Worksheets("Adekwatnosc")
        Set loc = .Cells.Find(what:=vDate)
      If Not loc Is Nothing Then
            lc = .Cells(loc.Row, Columns.Count).End(xlToLeft).Column
            .Range(.Cells(109, loc.Column), .Cells(123, lc)).Copy
      Set locPaste = wbMe.Sheets("input_forecast").Cells.Find(what:=vDate)
      wbMe.Sheets("input_forecast").Cells(27, locPaste.Column).PasteSpecial Paste:=xlPasteValues
      Application.CutCopyMode = False
        End If
    End With
data_wb.Close SaveChanges:=False
MsgBox "Wklejone!"
End Sub
Private Function selectFilePK()
    Dim fd As Office.FileDialog

    Set fd = Application.FileDialog(msoFileDialogFilePicker)

    With fd
        .InitialFileName = ActiveWorkbook.Path
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel", "*.xlsm"

        If .Show = True Then selectFilePK = .SelectedItems(1)
        Application.ScreenUpdating = False
        Application.AskToUpdateLinks = False
        End With
End Function```

Answer 1

在您的初始代碼中：

ThisMonth = Format(Date, "mmmm")
MyFolder = "C:\Users\G2121290\Documents\PriceQ" & ThisMonth & "\"
MyFile = Dir(MyFolder & "\FinalPrice*.xlsx")
Do Until MyFile = ""
    Set data_wb = Workbooks.Open(file_name, UpdateLinks:=0)
    MyFile = Dir
Loop

在Open語句中，您使用的是file_name而不是您之前定義的MyFile

Answer 2

添加一行有助於調試的代碼，如下所示：

file_name = selectFilePK
Debug.Print file_name
If file_name = "" Then Exit Sub

運行前按Ctrl + G顯示debug output。 那里的值是預期打開的文件。 如果這在某種程度上是錯誤的，請相應地調整selectFilePK 。