简体   繁体   中英

Using VBA to open files in a folder

I would like to open the file automatically after clicking the button, the folder is the same and the file name is the same every month. I wanted it to always select the most recent file from teog msc, eg if not, it would say that the file is too old. However, And i get error now Object Variable or With Block not Set. Here data_wb.Sheets("Adekwatnosc").Rows("1:1").Select This code like a would like create.To open my file automatically

   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

And here is the code I have.

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```

in your initial code:

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

in the Open statement you are using file_name instead of MyFile which you previously defined

Add a line that helps your debugging, like this:

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

Press Ctrl + G to show the debug output before running. The value there is the file that is expected to be opened. If that is wrong in some way, adjust selectFilePK accordingly.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM