I would like to open a file that is located in a different folder every week (file name remains the same but new week = new data).
Workbooks.Open "C:\Users\baguette\Documents\W44\L060.xlsx"
The week folder is obviously W44. Is there a way I could use a cell content that would be taken into account in the code?
For example, cell A1 of sheet1 of the file the code is run from would contain the week number that I would manually key in before running the procedure.
I tried this but did not work :
Workbooks.Open "C:\Users\baguette\Documents\& ThisWorkbook.Worksheets(1).Range("A1")\L060.xlsx"
I guess it was a bit rash.
Thank you for your help.
You are very close to your solution. Just try below-
Workbooks.Open "C:\Users\baguette\Documents\" & _
ThisWorkbook.Worksheets(1).Range("A1") & _
"\L060.xlsx"
You can decorate code using string type variable. Check below sub.
Sub OpenSpecificFile()
Dim FolderPath As String
Dim WeekFolder As String
FolderPath = "C:\Users\baguette\Documents\"
WeekFolder = ThisWorkbook.Worksheets(1).Range("A1")
Workbooks.Open (FolderPath & WeekFolder & "\L060.xlsx")
End Sub
Related
I am quite new in VBA and I’m looking to automate a current process using VBA.
For every week of each month (Wednesday), I need to export an existing Excel template from Internet into a new workbook. This part is done but i would need to :
Save it like: "01 05 2018_With taxes_1889". I have so far found and adapted the code below which, when run once, creates a temporary file and save it into my folder but do not closed it automatically.
It would be great to have all download file saved with their related date in my folder.
I’m also willing to completely automate the process with a query which will launch the process each Wednesday of each week?
Private Sub ADD_BTN_Click()
Dim line As Integer
Dim Ws As Worksheet
Dim DBS As Database
Dim RST As Recordset
Dim SQL_TXT As String
Dim COUNTRY_ID As Integer
Dim DATE_FUEL As String
Dim test As Boolean
DownloadFile (LINK_FUEL) ' Download file on C:\TEMP
Workbooks.Open (BUFFER_FILE)
Set Ws = ActiveWorkbook.Worksheets("Weekly Prices with taxes")
datEfuel = Right(Ws.Cells(1, 12), 10)
For line = 1 To 47
If OPEN_DBS(DBS, FUEL_DB) Then
SQL_TXT = "SELECT * FROM COUNTRY_DATA WHERE COUNTRY_NAME LIKE '" & Ws.Cells(line, 1).Value & "'" ' Search Country name
If OPEN_RST(DBS, RST, SQL_TXT) Then
COUNTRY_ID = RST![COUNTRY_ID]
RST.Close
SQL_TXT = "SELECT * FROM FUEL_DATA WHERE COUNTRY_ID=" & COUNTRY_ID
test = True
If OPEN_RST(DBS, RST, SQL_TXT) Then
While Not RST.EOF
If RST![FUELDATA_DATE] = CDate(datEfuel) Then test = False
RST.MoveNext
Wend
RST.Close
End If
If test Then
SQL_TXT = "SELECT * FROM FUEL_DATA"
OPEN_NEW DBS, RST, SQL_TXT
RST![COUNTRY_ID] = COUNTRY_ID
RST![FUELDATA_DATE] = datEfuel
RST![FUELDATA_AUTOMOTIVE] = Ws.Cells(line, 8).Value
RST.Update
End If
End If
DBS.Close
End If
Next line
End Sub
In order to close and save the workbook with a specified name, you can call the Close method on the Workbook object, with True as the first parameter to save changes, and the name under which you want to save the file as the second parameter:
Dim book As Workbook
...
book.Close True, "01 05 2018_With taxes_1889.xlsx"
The Workbook object is returned from the Workbooks.Open method:
'Instead of this:
' Workbooks.Open (BUFFER_FILE)
'use this:
Set book = Workbooks.Open (BUFFER_FILE)
If you want to use the current date as the name of the file, you can use the Date function:
book.Close True, Date & ".xlsx"
You may want to use a specific format for the date in the name; this can be done with the FormatDate function, which formats a date using a predefined set of date formats:
'Uses the long date format from the computer's regional settings
book.Close True, FormatDate(Date, vbLongDate) & ".xlsx"
or with the Format function, which allows for custom formatting:
book.Close True, Format(Date, "yyyy-mm-dd") & ".xlsx"
Note that this will save in the current folder of the application (usually the Documents folder), unless you specify the full path.
book.Close True, "C:\path\to\folder\" & Format(Date, "yyyy-mm-dd") & ".xlsx"
Excel doesn't provide facilities for scheduled tasks, which means you'll have to do one of the following:
use the Windows Task Scheduler to start the task. In that case I would strongly suggest not tying the code to a specific workbook, but rather using VBScript under Windows Script Host.
check each time the workbook (or whereever this VBA code is running from) is opened, and run the process under the appropriate conditions
I am trying to copy a file from one path to another and rename it. However the source folder contains several files, and the naming convention is the following: 123456_EXyymmdd.txt now the 123456 part is a randomly generated number, so I can only identify the file to copy for a given day by the EXyymmdd part. I have the following code where I tried to put the identifying segment of the string as "**" but it doesn't work, probably due to the date:
Sub SOQuestion()
Dim myDate1 As String
Dim Ipan1 As String
Dim Ipan2 As String
Dim mGlobalDate as string
mGlobalDate=Format(Date, "yyyymmdd")
myDate1 = Format(Date, "yymmdd")
Ipan1 = "157782_EX" & mGlobalDate & ".txt"
Ipan2 = "*_EX*" & myDate1 & ".TXT*"
'source path below
FileCopy "C:\sample\" & Ipan2, "C:\sample2\" & Ipan1
End Sub
It's confused because of the wildcard. It would be like copying a bunch of files to one file, which if you think about it, doesn't make much sense. Instead, use the wildcard and the Dir function to get the exact filename and use that as your source argument.
Dim sFilename as String
sFilename = Dir("C:\sample\" & Ipan2)
Then:
FileCopy "C:\sample\" & sFilename, "C:\sample2\" & Ipan1
MSDN Dir Function
Im trying to extract a copy of my workbook to a new file in VBA but I'm getting an "Application or object defined error" and i have no clue whats wrong.
All im using is the command i found on the microsoft site?
Public Function EWbtn()
ActiveWorkbook.SaveCopyAs "C:\CRC Chart Extract.XLS"
End Function
Im very confused :L
As Michal said, the easier way is just create the file first then populate it with your current active workbook. Here is a sample that should be able to get you started
Sub try_me()
Dim workbookPath As String
Dim output_filename As String
'getting your active workbook path
workbookPath = ActiveWorkbook.Path
'pre-defined output filename
output_filename = "my_other_worksheet"
'Copy your current active workbook to the new wb
ActiveWorkbook.Sheets.Copy
'save the workbook
ActiveWorkbook.SaveAs Filename:=x & "\" & y & ".xls"
End Sub
Credit to Smitty here:
https://www.mrexcel.com/forum/excel-questions/139831-create-empty-workbook-visual-basic-applications.html
I got the same error. I solved it by creating the file. Most probably copying can be done to existing file. Add code to create the file before copying to it.
It is doubtful that a function can do this. I tried below code and it's working.
Public Sub EWbtn()
ActiveWorkbook.SaveCopyAs "C:\CRC Chart Extract.XLS"
End Sub
I have VBA that, along with a whole lot of other stuff, saves an excel workbook to SharePoint (enterprise 2010 I think) and it works fine most of the time but every once in while, when a user runs the VBA, the Excel freezes with a pop up showing "Getting list of available content types and properties...". If the user selects cancel another pop up come up "Run-time error '1004': Method 'SaveAs' of object '_Workbook' failed. If the user selects 'Debug' the last line of VBA is highlighted as creating the error.
Dim fileName As String
Dim excelDirName As String
fileName = [c9]
excelDirName = [c16] & "/"
ThisWorkbook.SaveAs excelDirName & fileName & ".xls"
Since this works sometimes (and it worked for over 6 months without this happening) and not other times I am not sure what it could be and I am thinking something was updated in SharePoint.
I would write it a bit differently, so as to make it more robust:
With SomeSpecificSheet
Dim path As String
path = .Range("SavePath").Value
Dim fileName As String
fileName = .Range("SaveFileName").Value
End With
Debug.Assert Trim(path) <> vbNullString
Debug.Assert Trim(fileName) <> vbNullString
Dim savePath As String
savePath = path & "/" & fileName
ThisWorkbook.SaveAs savePath
Note:
Be explicit about the worksheet you're reading from - you're currently reading from whatever the active sheet is, and unless every single worksheet in ThisWorkbook has the expected values in $C$9 and $C$16, that's asking for trouble.
Use named ranges, so that if a user inserts a column before column C or a row before row 9, your code still refers to the correct cells.
Let SaveAs determine the file's extension.
Use Debug.Assert to verify assumptions (and break before you freeze). Alternatively, you can explicitly validate the values, for example:
If path = vbNullString Or fileName = vbNullString Then
MsgBox "I need a path!"
Exit Sub
End If
Hope you are well.
I'm trying to create a mass folder creator using Excel and vba. It's my first time using VBA as I usually focus on web-based languages so forgive me for my lack of knowledge in advance. I have some code already it's just putting the finishing touches that I'm struggling with.
Currently, the user specifies a directory in a given cell and name of the parent file in another cell. Upon clicking a button, the macro creates the parent folder using the directory and name from the parent file cell. It then creates sub folders using the values of any cells the respondent has selected upon running the macro.
I am currently struggling with the next stage of the project which is creating sub-folders (I'll just call them Grandchildren) within the subfolders. This would be easy if all of the subfolders had the same Grandchildren however, this is not the case. What I would like to do is grab the 3 values to the right of each cell which defines the name of the subfolder and use them to create the Grandchildren however I'm currently getting the 'Invalid Qualifier' message with the code I am currently using (see below).
BasePath = Range("folder_path")
'Check if the project folder already exists and if so raise and error and exit
If Dir(BasePath, vbDirectory) <> "" Then
MsgBox BasePath & " already exists", , "Error"
Else
'Create the project folder
MkDir BasePath
MsgBox "Parent folder creation complete"
'Loop through the 1st tier subfolders and create them
For Each c In ActiveWindow.RangeSelection.Cells
'create new folder path
NewFolder = BasePath & "\" & c.Value
'create folder
If fs.folderexists(NewFolder) Then
'do nothing
Else
MkDir NewFolder
End If
Next c
'Create GrandChildren
For Each d In ActiveWindow.RangeSelection.Cells
'Offset the selection to the right
For Each e In d.Offset(0, 1).Resize(1, 3).Cells
Test = e.Value
GrandChild = BasePath & "\" & d.Value & "\" & Test
If fs.folderexists(GrandChild) Then
'do nothing
Else
MkDir GrandChild
End If
Next e
Next d
MsgBox "Sub-folder creation complete"
End If
End Sub
If you require any further information please let me know.
Cheers,
Jason
I think your problem is here
Test = d.Offset(0, 1).Select
Test is a String and you are selecting a cell. You should try this:
Test = d.Offset(0,1).Value
You may find this useful, it's a simple routine I use to make ALL the folders in an entire path fed into the function.
EXAMPLE:
C:\2011\Test\
C:\2012\Test
C:\2013\Test\DeepTest\
C:\2014\Test\DeeperTest\DeeperStill
Based on the list above, this macro will attempt to create 11 directories, ones that exist already...no problem.
Option Explicit
Sub MakeDirectories()
'Author: Jerry Beaucaire, 7/11/2010
'Summary: Create directories and subdirectories based
' on the text strings listed in column A
' Parses parent directories too, no need to list separately
' 10/19/2010 - International compliant
Dim Paths As Range
Dim Path As Range
Dim MyArr As Variant
Dim pNum As Long
Dim pBuf As String
Dim Delim As String
Set Paths = Range("A:A").SpecialCells(xlConstants)
Delim = Application.PathSeparator
On Error Resume Next
For Each Path In Paths
MyArr = Split(Path, Delim)
pBuf = MyArr(LBound(MyArr)) & Delim
For pNum = LBound(MyArr) + 1 To UBound(MyArr)
pBuf = pBuf & MyArr(pNum) & Delim
MkDir pBuf
Next pNum
pBuf = ""
Next Path
Set Paths = Nothing
End Sub
There is a UDF version too and a sample file for testing found here. FYI.