使用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 。