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.