I created a macro button to open my daily files from a excel production sheet where I have all the my macro button for specific files.
The format for all my files are conventionally the same:
Businese Unit Name: YMCA
Year:2012
Month: April
Week: Week 2
Day: 12
File Name: YMC Template 041212.xlsm
I am having issue with the last excel file name extension.
how do I add the MyDaily Template and MyDateProd along with the .xlsm.
I have this -J:.....\& myDailyTemplate & myDateProd.xlsm") see below for entire file path names.
Sub Open_DailyProd()
Dim myFolderYear As String
Dim myFolderMonth As String
Dim myFolderWeek As String
Dim myFolderDaily As String
Dim myDateProd As String
Dim myBusinessUnit As String
Dim myDailyTemplate As String
myBusinessUnit = Sheet1.Cells(32, 2)
myFolderYear = Sheet1.Cells(11, 2)
myFolderMonth = Sheet1.Cells(12, 2)
myFolderWeek = Sheet1.Cells(13, 2)
myFolderDaily = Sheet1.Cells(14, 2)
myDateProd = Sheet1.Cells(15, 2)
myDailyTemplate = Sheet1.Cells(6, 5)
Application.Workbooks.Open ("J:\IAS\3CMC05HA01\IAC Clients\myBusinessUnit\myFolderYear\myFolderMonth\myFolderWeek\myFolderDaily\& myDailyTemplate & myDateProd.xlsm")
End Sub
Excel is looking for a file called:
"J:\IAS\3CMC05HA01\IAC Clients\myBusinessUnit\myFolderYear\myFolderMonth\myFolderWeek\myFolderDaily\& myDailyTemplate & myDateProd.xlsm"
since that is what is included in the quotes, but from your code, you appear to have a number of variables that are part of this string, you need to take them out of the quotes and concatenate them together. Try something like this:
"J:\IAS\3CMC05HA01\IAC Clients\" & myBusinessUnit & "\" & myFolderYear _
& "\" & myFolderMonth & "\" & myFolderWeek & "\" & myFolderDaily & _
"\" & myDailyTemplate & myDateProd & ".xlsm"
I added the continuation _ to make it more readable onthe screen here, but it is not necessary, you can put everything on one line together if you prefer.
Unless you need all of the myBusinessUnit, myFolderYear, etc variables elsewhere, I would think about doing it in some sort of array and then doing a Join function to concatenate everything. I, personally, find this easier to maintain going forward and easier to see the hierarchy in the folder structure rather than looking at a very long string and trying to find what part of the path is wrong.
Sub Open_DailyProd()
Dim pathParts(1 To 10) As String
Dim path As String
pathParts(1) = "J:"
pathParts(2) = "IAS"
pathParts(3) = "3CMC05HA01"
pathParts(4) = "IAC Clients"
pathParts(5) = Sheet1.Cells(32, 2)
pathParts(6) = Sheet1.Cells(11, 2)
pathParts(7) = Sheet1.Cells(12, 2)
pathParts(8) = Sheet1.Cells(13, 2)
pathParts(9) = Sheet1.Cells(14, 2)
pathParts(10) = Sheet1.Cells(6, 5) & Sheet1.Cells(15, 2) & ".xlsm"
path = Join(pathParts, "\")
Application.Workbooks.Open (path)
End Sub
Related
Using 2010 Excel VBA - I need to use look up the image/pdf with the Branch Code as a part of its name at "C:\ECB Test\ECB IR COPY" and paste it at "C:\ECB Test\" RO if it exists. If it doesn't, the program needs to highlight the Branch Code.
(File Name Examples: 28-Kochi-ecb-sdwan completed.pdf, 23 eCB Kozhikode completed.pdf/0036.jpeg)
Having done this manually twice for two other excel sheets (4k+ cells), I decided to Frankenstein a module together and, well, it does not work and I have no idea why.
Sub Sort()
Const SRC_PATH As String = "C:\ECB Test\ECB IR COPY"
Const DEST_PATH As String = "C:\ECB Test"
Dim Row_Number As Integer
Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
Dim Folder_Name As String
Dim Branch_Code As String
Dim Final_Path As Variant
Dim File As String
For Row_Number = 3 To 2465
Branch_Code = Worksheets("WAN RFP").Cells(Row_Number, 2)
Folder_Name = Worksheets("WAN RFP").Cells(Row_Number, 5)
On Error Resume Next
File = Dir(SRC_PATH & "\*" & Branch_Code & "*")
Final_Path = Dir(DEST_PATH & "\" & Folder_Name & "\")
If (Len(File) > 0) Then
Call fso.CopyFile(File, Final_Path)
Else
Cells(Row_Number, 2).Interior.ColorIndex = 6
End If
On Error GoTo 0
DoEvents
Next Row_Number
End Sub
I think its unable to use the Branch Code variable as a wildcard, though I might as well have done something silly somewhere in the code. Can someone please help me out?
The problem is you are using the destination path instead of the source path:
File = Dir(DEST_PATH & "*" & Branch_Code & "*.*")
Change it to
File = Dir(SRC_PATH & "*" & Branch_Code & "*.*")
I'm trying to adapt an Excel form I created that uses drive locations to save copies of the form, to work with SharePoint in a similar manner. Currently, the first macro is set up such that it will search the contents of a particular folder to determine the next available number in the queue (i.e. if 1, 2 and 4 already exist, it will assign 3) and save the sheet as that next available number. When the sheet is complete, the second macro will save the file with a specified name based on data within the sheet, in another specified location (again based on data defined within the sheet). The drive is in the process of being retired in our company and everything moved to Cloud-based storage, so I would like a way to complete the same actions but using SharePoint directories.
The code for the first macro is as follows:
Dim strDir As String
Dim file As Variant
Dim savename As Integer
Dim savename_string As String
strDir = "R:\Queue\"
savename = 1
savename_string = CStr(savename)
file = Dir(strDir)
While (CInt(savename_string) = savename)
If file <> (savename & ".xlsm") Then
If file = "" Then
savename = savename + 1
Else
file = Dir
End If
ElseIf file = (savename & ".xlsm") Then
savename = savename + 1
savename_string = CStr(savename)
file = Dir(strDir)
End If
Wend
ActiveWorkbook.SaveAs ("R:\Queue\" & savename_string & ".xlsm")
And then the code for the second macro is as follows:
Dim answer As Integer
Dim error As Integer
Dim delete As String
answer = MsgBox("Are you sure you want to save sheet & close?", vbYesNo + vbQuestion, "WARNING")
If answer = vbYes Then
'Define PWO, assembly, terminal, strand, and gauge As Strings, and define which cells they are on the sheet
delete = ActiveWorkbook.Name
ActiveWorkbook.SaveAs ("R:\" & terminal & assembly & Space(1) & gauge & strand & Space(1) & PWO & Space(1) & Format(Now(), "MM-DD-YYYY") & ".xlsm")
Kill ("R:\Queue\" & delete)
ActiveWorkbook.Close
Else
Exit Sub
End If
Currently the second macro works correctly when replacing the locations with the SharePoint URL locations, but when doing the same with the first macro, it returns an error message "Bad file name or number" at the line file = Dir(strDir). Can I get this code in working order, or is there a better way I should go about this? Thanks!
Forgive me if this is an easy problem, Im still learning..
I have an excel file, that takes data and performs analytics to compose graphs. right now method to update is manual copying and pasting from 2 other data sources. I can easily create a macro to import the first source as the data location/file name is always the same. The second source is trickier, as the file has some standardized naming convention, but a date is added, as it is refreshed once a week, every Monday or tuesday. is there a way to automate pulling the data from the external source (sharepoint library) and telling it to find the most current version? either by understanding the date convention added in the file name, or by another means of modified date or other criteria? the file is kept with previous archived copies. I do not own the report, sharepoint site, or library it is kept in, so I cant influence those factors :(. any help appreciated, and I can provide better details and explanation.
There are two basic approaches that I know of, either allow the user to choose the file through a dialog box, or use the "Dir" function to find the file with the most recent date.
First approach (code I use frequently):
Public Function ChooseOpenFile() As String
Dim strSlash As String
If InStr(1, ActiveWorkbook.Path, "/") > 0 Then
strSlash = "/"
Else
strSlash = "\"
End If
With Application.FileDialog(msoFileDialogOpen)
.Title = "Select the first file to open in series:"
.InitialFileName = Replace(ActiveWorkbook.Path, "http:", "", 1) & strSlash
Call .Filters.Clear
Call .Filters.Add("Excel Files Only", "*.xls, *.xlsx, *.xlsb")
'only allow the user to select one file
.AllowMultiSelect = False
'make the file dialog visible to the user
intChoice = .Show
'determine what choice the user made
If intChoice <> 0 Then
'get the file path selected by the user
ChooseOpenFile = .SelectedItems(1)
End If
End With
End Function
As for the second approach, as long as you can already access the folder programmatically, you build a loop to cycle through the files, extract the date from each file, test for being more recent than previous versions and store the filename of the most recent version to pass out of the loop.
Function MostRecentFile() As String
Dim dateTest As Date
Dim dateRecent As Date
Dim strMyFile As String
Dim strMyFolder As String
Dim strCurrentFile As String
Dim strSlash As String
strMyFolder = ThisWorkbook.Path
If InStr(1, strMyFolder, "/") > 0 Then
strSlash = "/"
Else
strSlash = "\"
End If
strMyFile = Dir(Replace(strMyFolder, "http:", "") & strSlash & "*.xls*")
Do While strMyFile <> ""
'Modify this line (number of characters and extension to replace) as needed.
dateTest = CDate(Replace(Right(strMyFile, 15), ".xls*", ""))
If dateTest > dateRecent Then
dateRecent = dateTest
strCurrentFile = strMyFile
End If
Stop
Dir
Loop
MostRecentFile = strCurrentFile
End Function
You can browse to the file.
Sub GetOpenFile()
Dim fileStr As String
fileStr = Application.GetOpenFilename()
If fileStr = "False" Then Exit Sub
Workbooks.Open fileStr
End Sub
If you want some kind of automated solution, based on your system date, like the next Monday ot Tuesday, you can get the machine to figure it out, and pass the result to the appropriate string in the file path.
Sub NameAsNextMon()
Dim K As Integer
Dim dteMon As Date
Dim tempName As Variant
K = Weekday(Now)
dteMon = Now() + (9 - K)
tempName = Year(dteMon) & "-" & Month(dteMon) & "-" & Day(dteMon) & ".xls"
Do
fName = Application.GetSaveAsFilename(tempName)
Loop Until fName <> False
ActiveWorkbook.SaveAs Filename:=fName
End Sub
(Excel 2010)
I'm trying to grab specific lines from a variety of "target" workbooks in different but similar folders. I have found that I am able to pull this data when the source ("LM", the workbook the code is executing in, and that I want to pull the data to) and target workbooks are in the same folder without opening the target's workbook, but when they are in different locations (as they will be in practice) I receive a "Subscript out of range" error for the
LM.Worksheets("Sheet1").Range("B" & i + 1 & ":G" & i + 1).Value = _
Workbooks(filename).Worksheets("Sheet1").Range("B6:G6").Value
line. I have tried:
Using every variant & combination on pathname, dirname & filename, etc. as the argument for the latter Workbooks(). I have also had it MsgBox me the pieces and whole of pathname and filename to look at, which are error-free.
Replacing the latter Workbooks(filename) with a workbook variable (lets call it Targ), like LM (which works fine)
Changing the path with ChDir and ChDrive (& I have confirmed that the CurDir() is in fact the target directory when this is running) and doing the above
Using ThisWorkbook instead of LM for the call
Basically every permutation of the above ideas
Here is a stripped-down (because confidential stuff was in there) version of the code (which works fine if I un-comment Workbooks.Open and Workbooks.Close, but I want a more efficient method since this is a busy network and people are in-and-out of these files all the time. The fact that I can do this without opening the files if they're in the same folder tells me I'm onto something...)
Sub Import()
Dim directory As String, fileName As String, LM As Workbook, i as Integer
Set LM = Workbooks("LM.xlsm")
i = 1
Dim DirArray As Variant
'this is the array that handles the variations on the path, doesn't seem to be the problem
DirArray = LM.Worksheets("Sheet2").Range("DirTable")
Do While i <= UBound(DirArray)
directory = DirArray(i, 1)
dirname = "C:\blahblahblah"
fileName = Dir(dirname & "*.xl??")
pathname = dirname & fileName
ChDir dirname
' Workbooks.Open (dirname & fileName)
LM.Worksheets("Sheet1").Range("B" & i + 1 & ":G" & i + 1).Value = _
Workbooks(filename).Worksheets("Sheet1").Range("B6:G6").Value
i = i + 1
' Workbooks(fileName).Close
Loop
End Sub
If I could just figure out what is different when they're in the same folder! Navigating with ChDir and ChDrive doesn't seem to do any good...
It's unclear exactly what you want to do, but this should be a working version of your posted code.
Is there only one Excel file per folder? Did you want to use directory in place of the hard-coded DIRNAME ?
Sub Import()
Const DIRNAME As String = "C:\blahblahblah\"
Dim directory As String, fileName As String, LM As Workbook, i As Integer
Dim DirArray As Variant, wb As Workbook
Set LM = Workbooks("LM.xlsm") 'ThisWorkbook ?
DirArray = LM.Worksheets("Sheet2").Range("DirTable").Value
For i = 1 To UBound(DirArray, 1)
directory = DirArray(i, 1) 'what are these values ?
fileName = Dir(DIRNAME & "*.xl??")
If fileName <> "" Then
'ChDir dirname '<< you do not need this if you pass the full path to Open...
Set wb = Workbooks.Open(filename:=DIRNAME & fileName, _
ReadOnly:=True, UpdateLinks:=0)
LM.Worksheets("Sheet1").Range("B" & (i + 1) & ":G" & (i + 1)).Value = _
wb.Worksheets("Sheet1").Range("B6:G6").Value
wb.Close False 'no save
End If
Next
End Sub
I'm trying to save excel file into a specific path.
So basically, when I click the button, I'm creating a folder, and want to save the file inside that folder.
The created folder has the current month as name. I'm trying to save into that current month folder.
'Create folder as Month Name. Save filename as date inside "month".
Dim sDate As String = DateTime.Now.ToString("yyyy-MM-dd") & "_" & DateTime.Now.ToString("HH-mm-ss")
Dim sMonth As String = DateTime.Now.ToString("MMMM")
Dim sFolder = Application.StartupPath & "\Resources\Excel\"
My.Computer.FileSystem.CreateDirectory(sFolder & Format(sMonth))
Dim sfinal = Path.Combine(sFolder, sMonth)
xlSh.SaveAs(sfinal & Format(sDate) & ".xlsx")
xlApp.Workbooks.Close()
xlApp.Quit()
As it is, this code doesn't give me any errors. But instead of creating a folder named "March" <-current month and saving inside it, it saves the file in \Excel\ and it also creates folder in the same place.
you could use the following function (similar to .NET System.IO.Path.Combine)
Function PathCombine(path1 As String, path2 As String)
Dim combined As String
combined = path1
If Right$(path1, 1) <> Application.PathSeparator Then
combined = combined & Application.PathSeparator
End If
combined = combined & path2
PathCombine = combined
End Function
Hope this helps!
After long hours of excruciating pain, I've finally did it!
Apparently I was missing an "\"
Since "sMonth" became dynamic name, which later I wanted to use as path, and save files in that folder. I needed to simply put that "\" after sMonth, to tell it to save inside it.
Before I realize this... I've broken down, simplified the code as much as I could so I can logically connect the pieces. What I ended up with, is something slightly different. Now the SaveAS properly saves the file inside the new folder.
Dim sDate As String
sDate = DateTime.Now.ToString("yyyy-MM-dd") & "_" & DateTime.Now.ToString("HH-mm-ss")
Dim sMonth As String
sMonth = DateTime.Now.ToString("MMMM")
Dim sFileName As String
sFileName = sDate + ".xlsx"
Dim sFolder As String
sFolder = Application.StartupPath & "\Resources\Excel\"
Dim sfinal As String
sfinal = (sFolder & sMonth & "\") '<- this thingie here o.O
My.Computer.FileSystem.CreateDirectory(sFolder & Format(sMonth))
xlSh.SaveAs(sfinal & Format(sFileName))
xlApp.Workbooks.Close()
xlApp.Quit()
Thanks for the help.
You don't appear to actually be setting the save path to the created directory. Instead, I believe you're appending the month to the beginning of the file name in the xlSh.SaveAs(sFinal & Format(sDate) & ".xlsx"). Basically (though I'm not sure of the specific command) you need to navigate to the folder you created after you create it. Probably something to the format of
My.Computer.FileSystem.ChangeDirectory(sFolder & Format(sMonth))
though I don't know that that specific command actually exists as I wrote it.
To those who have been wondering wtf I was doing with all this, here is the full sub. And if anyone needs something similar. Thanks for the support. Problem has been resolved.
Private Sub Button_Click(sender As Object, e As EventArgs) Handles Button.Click
Dim xlApp As Excel.Application
Dim xlSh As Excel.Worksheet
xlApp = New Excel.Application
xlApp.Workbooks.Add()
xlSh = xlApp.Workbooks(1).Worksheets(1)
'Items from listbox1 to be exported into excel, second row, second column.
Dim row As Integer = 2
Dim col As Integer = 2
For i As Integer = 0 To ListBox1.Items.Count - 1
xlSh.Cells(row, col) = ListBox1.Items(i)
row = row + 1
Next
row += 1
col = 1
'Items from listbox2 to be exported into excel, second row, third column.
Dim row2 As Integer = 2
Dim col2 As Integer = 3
For i As Integer = 0 To ListBox2.Items.Count - 1
xlSh.Cells(row2, col2) = ListBox2.Items(i)
row2 = row2 + 1
Next
row2 += 1
col2 = 1
'Create folder as Month Name. Save filename as date inside that folder.
'Make filename be yyyy-MM-DD_HH-mm-ss
Dim sDate As String
sDate = DateTime.Now.ToString("yyyy-MM-dd") & "_" & DateTime.Now.ToString("HH-mm-ss")
'This will be used as name for the new folder.
Dim sMonth As String
sMonth = DateTime.Now.ToString("MMMM")
'Filename + extension.
Dim sFileName As String
sFileName = sDate + ".xlsx"
'This is the path.
Dim sFolder As String
sFolder = Application.StartupPath & "\Resources\Excel\"
'This is the path combined with sMonth to make the final path.
Dim sfinal As String
sfinal = (sFolder & sMonth & "\")
'Check if folder with the name sMonth already exists.
If Dir(sFolder, vbDirectory) = sMonth Then
'If it exist, then simply save the file inside the folder.
xlSh.SaveAs(sfinal & Format(sFileName))
Else
'If it doesn't exist:
'This is the creation of sMonth folder, inside "\excel\.
My.Computer.FileSystem.CreateDirectory(sFolder & Format(sMonth))
'This saves the excel file at path sfinal, with filename of sFileName
xlSh.SaveAs(sfinal & Format(sFileName))
End If
'Close everything.
xlApp.Workbooks.Close()
xlApp.Quit()
End Sub
I find this method to be much easier.
Create a FileSystemObject and use BuildPath Method, like so:
Set fs = CreateObject("Scripting.FileSystemObject")
skPath = fs.BuildPath(ActiveDocument.Path, "Survival Story of Sword King")
Attention: ActiveDocument.Path is current directory in Word and does not work in excel or other. for excel it would be ActiveWorkbook.Path
My point is some methods or namespace are application specific.