My goal is to open a excel file inside a Visual Basic Macro in a Word file.
The two files (the word file with the macro and the excel file I want to open) are in the same folder, named like this:
C:/.../123 - 345823847/123 - OTE.xlsx
As you can see, the file have a name composed by a number and " - OTE.xlsx", and that number is the same as the first number in the name of the folder that contains the two files.
Sub SuperMacroFV()
Dim Excel
Set Excel = CreateObject("Excel.Application")
Excel.Visible = True
Set wb_datos = Excel.Workbooks.Open(ActiveDocument.Path & "\"{the number here}" - OTE.xlsx")
My goal is to try to open the file dynamically by knowing the number of the file by obtaining it from the name of the folder.
Another option could be to open the file knowing that it is always ended with OTE.xlsx.
If your Excel file is in the same folder than your Word file, try this:
Sub SuperMacroFV()
Dim Excel As Object
Dim vPath As String
Set Excel = CreateObject("Excel.Application")
Excel.Visible = True
vPath = Split(ActiveDocument.Path, "\")(UBound(Split(ActiveDocument.Path, "\"))) 'last folder of path
vPath = Split(vPath, " - ")(0) 'pattern is 123 - 345823847 and we need everything before dash (123), first position of array
Set wb_datos = Excel.Workbooks.Open(ActiveDocument.Path & "\" & vPath & " - OTE.xlsx")
End Sub
One way:
Dim pos As Long
Dim file As String
'// get position of the last \
pos = InStrRev(ActiveDocument.Path, "\")
'// extract from the last \ to the first space
file = Mid$(ActiveDocument.Path, pos + 1, InStr(pos, ActiveDocument.Path, " ") - pos - 1)
'// final
file = ActiveDocument.Path & "\" & file & " - OTE.xlsx"
Related
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!
Another user greatly helped me with this but I am stuck on a few parts.
The purpose of the macro:
The purpose is to take the fifth element number in the current file path then rename the file with that number and a string following it. Then I want to convert it to CSV from XLSM
The comments I have outlined explain what each block code's description is. I am not sure how to change it so that I need not to use CONST since I want to find a variable that is found at run-time and const only uses compile-time.
Const original is meant to be assigned the current workbook. I do not want a hardcoded file path in the macro.
Ensuring that the xlsm copy is left alone but renamed so that it matches XLSM
There will be a CSV copy and a XLSM copy
The file path that I have been testing on is R:\3.0 Projects\2.0 Current Projects\2021 JOBS\999111-DO-Customer-Description\2.0 Estimate\2.7 Final Estimates\FoundationImport-TMP-IFI-REV12.XLSM
I want the final file to be " R:\3.0 Projects\2.0 Current Projects\2021 JOBS\999111-DO-Customer-Description\2.0 Estimate\2.7 Final Estimates\999111import-TMP-IFI-REV12.XLSM
I appreciate your guys help greatly!
Function getName(pf): getName = Split(Mid(pf, InStrRev(pf, "\") + 1), ".")(0): End Function
Sub Snippet()
Const Original As String = "R:\3.0 Projects\2.0 Current Projects\2021 JOBS\999111-DO-Customer-Description\" & _
"2.0 Estimate\2.7 Final Estimates\FoundationImport-TMP-IFI-REV12.XLSM"
'Original = getName(ActiveWorkbook.FullName)
Dim Ext As String ' file extension
Dim Fn As String ' file name
Dim Path As String ' file path
Dim Ffn As String ' full file name
Dim Sp() As String
Dim CSVfile
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Foundation Budget Template")
' extracts number from 5th element and applies to file name
Sp = Split(Original, "\")
Fn = Sp(UBound(Sp))
Sp(7) = Split(Sp(4), "-")(0) & "import-TMP-IFI-REV12"
Ffn = Join(Sp, "\")
MsgBox "Original Ffn: " & Original & vbCr & vbCr & _
"Changed 5th element: " & Ffn
'Convert file from XLSM to CSV
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=CSVfile, FileFormat:=xlCSV, local:=True
' append a file name to path
Sp = Split(Path, "\")
Fn = "My File Name" & "." & Ext
ReDim Preserve Sp(UBound(Sp) + 1)
Sp(UBound(Sp)) = Fn
Ffn = Join(Sp, "\")
MsgBox "Full File Name = " & Ffn
End Sub
I have a VBA script in an Excel workbook that gathers results from all the workbooks in a particular folder.
Private Sub Workbook_Open()
Dim path As String
Dim fso As Object
Dim folder As Object
Dim file As Object
Dim i As Integer
Dim data As Object
Set data = Worksheets("RawData")
path = data.Range("A1").Value
i = 3
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(path)
data.Rows("2:" & data.Rows.Count).ClearContents
For Each file In folder.Files
If Right(UCase(file.name), 5) = ".XLSX" And Left(file.name, 1) <> "~" Then
data.Cells(i, 2) = "='" + path + "\[" + file.name + "]Summary'!A1:J1"
i = i + 1
End If
Next file
End Sub
The idea is for each .xlsx file in a given folder, I add a reference to the results range in that file. For example, if there is a file Test1.xlsx in folder C:\Sheets, the VBA puts the following formula into some row on the sheet containing the script:
='C:\Sheets\[Test1.xlsx]Summary'!A1:J1
Excel then pulls values out of Test1 and puts them in the current workbook's RawData sheet.
This worked until today, when my formulas started ending up with # right after the = sign, like this:
=#'C:\Sheets\[Test1.xlsx]Summary'!A1:J1
This gives me a #VALUE?.
Excel helpfully gave me a message stating that it has just now started inserting # into formulas due to some syntax changes, but that it wouldn't affect calculations. I can't get this message to show up again, but that was the gist of it. Obviously it does affect calculations. If I manually remove the # from the formula, it works fine.
I have Office 365 and I guess I must have received an update recently that added this "feature" because all this used to work fine.
If I modify the VBA script to reference only a single cell, the # does not get inserted. But using a named range for the results (rather than A1:J1) still has the problem.
Anyone have any ideas for a workaround?
To avoid the # from being inserted, use the .Formula2 property of the range object.
This change has to do with the dynamic array feature of Excel O365
You could assign the formula to a variable and then remove the # from the string using the Right() function...
As the length of the string will be dynamic depending on the length of the file name, I've used the Len() function to get the full lenght of the string, then minus 2 from it to remove the = and #.
Note the = is concatenated with the Right() function when assigning the value to the cell.
Dim FormulaString as String
For Each file In folder.Files
If Right(UCase(file.name), 5) = ".XLSX" And Left(file.name, 1) <> "~" Then
FormulaString = "='" + path + "\[" + file.name + "]Summary'!A1:J1"
data.Cells(i, 2) = "=" & Right(FormulaString, Len(FormulaString) - 2)
i = i + 1
End If
Next file
Output is
='C:\Sheets\[Test1.xlsx]Summary'!A1:J1
The code below shows my save macro. Right now it saves the current workbook in a specific file path with the current workbook name. How can I add today's date in the current workbook name? So it saves to the designated file path with the current workbook name and today's date on the end?
Sub Save_Workbook()
ActiveWorkbook.SaveAs "H:\HR\Cole G\Timehseet Test Path\" & ActiveWorkbook.Name
End Sub
First off, .Name may or may not include a file extension, depending on if the file has been saved or not. (eg. "Test.xls" or "Book2")
Const Path = "H:\HR\Cole G\Timehseet Test Path\"
Dim Pos as Long
Pos = InStrRev(ActiveWorkbook.Name, ".") - 1
' If there wasn't a ".", then the file doesn't have an extension and Pos = -1
If Pos < 0 then Pos = Len(ActiveWorkbook.Name)
' Now put everything together, including the file extension...
ActiveWorkbook.SaveAs Path & Left(ActiveWorkbook.Name,Pos) & Format(Now, "yyyy-mm-dd") & Mid(ActiveWorkbook.Name,Pos+1)
This should be reliable regardless of file extension (even if there is no file extension!), as long as you're using common Excel file types. If you're opening weird .HTML files it may need some tweaking.
Sub Save_Workbook()
Dim fileNameWithoutExtension as String
fileNameWithoutExtension = getFileNameWithoutExtension(ActiveWorkbook)
ActiveWorkbook.SaveAs "H:\HR\Cole G\Timehseet Test Path\" & fileNameWithoutExtension & Format(Date, "YYYY-MM-DD"), FileFormat:=ActiveWorkbook.FileFormat
End Sub
Function getFileNameWithoutExtension(wb As Workbook)
Dim baseName As String
If (wb.Name = wb.FullName) Then
' This handles files that have not been saved, which won't have an extension
baseName = wb.Name
GoTo EarlyExit
End If
Select Case wb.FileFormat
Case xlOpenXMLAddIn, xlOpenXMLStrictWorkbook, xlOpenXMLTemplate, xlOpenXMLTemplateMacroEnabled, _
xlOpenXMLWorkbook, xlWorkbookDefault
' These all have a 4-character extension
baseName = Left(wb.Name, Len(wb.Name) - 5)
Case Else
' almost every other file type is a 3-character extension,
' but modify if needed based on this enumeration:
' https://msdn.microsoft.com/en-us/vba/excel-vba/articles/xlfileformat-enumeration-excel
baseName = Left(wb.Name, Len(wb.Name) - 4)
End Select
EarlyExit:
getFileNameWithoutExtension = baseName
End Function
I am trying to create a macro that will search a folder for a .dat file that contains "OPS"(not case sensitive) in the name, if it finds a file I would like to open it and run another macro, save the file as the original filename.xlsm, and close.
So far, I am able to search for the name but that's about the extent of my knowledge.
Sub Test2()
Dim sh As Worksheet, lr As Long, fPath As String, fName As String, rFile() As Variant
fPath = "C:\Users\ntunstall\Desktop\test\"
ctr = 1
fName = dir(fPath & "*.dat")
Do Until fName = ""
If InStr(fName, "OPS") > 0 Then
ReDim Preserve rFile(1 To ctr)
rFile(ctr) = fName
ctr = ctr + 1
End If
fName = dir
Loop
For i = LBound(rFile) To UBound(rFile)
'The variable rFile(i) represents the workbooks you want to work with.
MsgBox rFile(i)
Next
End Sub
Ideally, this macro would run any time a .dat file containing OPS in the filename is opened. Any help is appreciated, thanks.
To the top add
Dim wb as workbook
and then replace your message box line with
Set wb = Workbooks.Open(fPath & rFile(i))
wb.SaveAs fPath & Split(rFile(i), ".")(0), xlOpenXMLWorkbookMacroEnabled
wb.Close
I tested with a tab deliminated file and it worked well. Your issues may vary if you have a different format.