I would like to create a VB "Save As" macro for Excel that would utilize the data from cell B7,B5 and =NOW as the file name. This new file name would then be saved to a particular directory. (Ex. User clicks "Save" button. File name = (B5)ABCD_(B7)EFGH_=NOW is created and then saved to a directory of my choosing.
I have found scripts that offer some of the singular options, but have had no luck finding or creating a script of my own with these options. Any help would be greatly appreciated.
You need to substitute for the invalid characters in the filename (they can't contain / or :) with periods or something else.
Sub DateFile()
Dim str As String
str = Range("B5").Value & "ABCD_" & Range("B7").Value & "EFGH" & Now()
str = Replace(str, "/", ".")
str = Replace(str, ":", ".")
ActiveWorkbook.SaveAs (str)
End Sub
This can then be integrated into your push button code.
Related
I am having trouble getting this macro to work. I am working on a Windows 10 computer with Office 2013. The code was not written by me and I have limited knowledge in VB. The marco is supposed to update a a word document's links by mirroring how the the previous word document was linked. Below is the code, if anyone could help that would be great.
Sub relinking()
Dim oriacro As String
Dim taracro As String
Dim path As String
oriacro = InputBox(Prompt:="please enter the original agency acronym.", Title:="ENTER THE ORIGINAL AGENCY ACRONYM")
taracro = InputBox(Prompt:="please enter the target agency acronym.", Title:="ENTER THE TARGET AGENCY ACRONYM")
path = InputBox(Prompt:="please enter the target path.", Title:="ENTER THE TARGET PATH")
Excel.Application.Quit
'close all the excel files.(excel reference has to be activated in tool->reference'
For x = 1 To ActiveDocument.Fields.Count
'the program runs over all the linked fields'
If Left(ActiveDocument.Fields(x).LinkFormat.SourceNam e, Len(oriacro)) = oriacro Then
'read all the fields that has "original agency acronym" in the beginning of its linked excel files.'
ActiveDocument.Fields(x).LinkFormat.SourceFullName = path & "\" & taracro & "_" & Right(ActiveDocument.Fields(x).LinkFormat.SourceNa me, Len(ActiveDocument.Fields(x).LinkFormat.SourceName ) - InStr(ActiveDocument.Fields(x).LinkFormat.SourceNa me, "_"))
'Assign the fields with new links that are created from combining the "target path" ,"target agency acronym", and the parts of the names right after the original acronyms of the original linked file names.'
Else
'Leave other linked fields as they are.'
End If
Next x
MsgBox ("All Fields have been relinked!")
End Sub
1) few typos in the above code which might just be formatting on StackOverflow: .SourceNam e a couple times. Also in the function which makes the new path:
Right(ActiveDocument.Fields(x).LinkFormat.SourceNa me, Len(ActiveDocument.Fields(x).LinkFormat.SourceName ) - InStr(ActiveDocument.Fields(x).LinkFormat.SourceNa me, "_")).
Also add a string variable and catch one of them in a msgbox to test:
If Left(ActiveDocument.Fields(x).LinkFormat.SourceNam e, Len(oriacro)) = oriacro Then
'read all the fields that has "original agency acronym" in the beginning of its linked excel files.'
str = ActiveDocument.Fields(x).LinkFormat.SourceName 'Dim str variable above if necessary
ActiveDocument.Fields(x).LinkFormat.SourceFullName = path & "\" & taracro & "_" & Right(str, InStrRev(str, "_")-1)
'Assign the fields with new links that are created from combining the "target path" ,"target agency acronym", and the parts of the names right after the original acronyms of the original linked file names.'
msgbox ActiveDocument.Fields(x).LinkFormat.SourceFullName 'does this message show the proper path??
Else
'Leave other linked fields as they are.'
End If
ActiveDocument.Fields.Update
I would like to have a user be able to type in the directory of another spreadsheet into a cell, then use that in my macro. In code like:
Range("X1") = Directory
Range("A1").FormulaR1C1 = 'Directory'!RC)
When Range("X1") is where the user types in the Directory of the desired reference file
It looks like you're trying to reference a separate sheet in the same workbook. If that's the case then you can try:
Range("A1").FormulaR1C1 = "'" & Range("X1").Value & "'!RC..."
However, this works very similarly to the =INDIRECT() worksheet function which may be a better solution especially if this is a static formula. To use this, in cell A1 enter:
=INDIRECT("'" & X1 & "'!RC...")
You can read more about the INDIRECT function here.
You can make user choose a file from a dialog box by
range("X1").value = application.getopenfilename
dim MyDir as string
MyDir = range("X1").value ' and use MyDir variable in code from now on
Hope that was what you were looking for, cheers
I am trying to write a VLOOKUP in a cell as a string, with VBA. This means that I do not want the result to appear in the cell as a value, but I want the whole VLOOKUP expression instead (For this example : "VLOOKUP(C6,'[path_to_file.xlsm]OTD Table!$B:$F,4,0)"). The challenge is that the range argument of the VLOOKUP is a concatenation of a path (path_to_file.xlsm) that the user selects with a GetOpenFilename, and a string that specifies the tab in which the lookup table is located ("OTD Table!$B:$F,4,0").
The issue I am getting is very interesting :
When I print my expression in a Msgbox, the expression appears correctly. However, when I write it in a cell, the path mysteriously appears incorrectly.
Sub macro()
dim data_file_new as String
data_file_new = CStr(Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xls*),*.xls*", Title:="Select new data file")) ' The user selects the file
str_ = "=VLOOKUP(C6," & "'[" & data_file_new & "]OTD Table!$B:$F,4,0)" ' This will display the expression correctly
cells(1,10)="=VLOOKUP(C6," & "'[" & data_file_new & "]OTD Table!$B:$F,4,0)"' This will not display the same thing as in the messagebox above
end Sub
I hope one of you guys can make sens of this !
Because you're dropping a formula into a cell that you want to display as straight text, you have to be explicit with Excel and tag the text string to prevent interpreting it as a formula. The simplest way to do this is pre-pend the string with a single-quote "'".
Sub macro()
Dim data_file_new, str_ As String
str_ = "'=VLOOKUP(C6,'["
data_file_new = CStr(Application.GetOpenFilename(FileFilter:="Excel Workbooks (*.xls*),*.xls*", Title:="Select new data file")) ' The user selects the file
str_ = str_ & data_file_new & "]OTD Table!$B:$F,4,0)" ' This will display the expression correctly
ActiveSheet.Cells(1, 10).Value = str_
End Sub
Yeah either you'll need to set the string to add a single quote, or you'll need to change the numberformat of the cell to text (Cells(1,10).NumberFormat = "#")
Either of those should work.
I really need help. I need a VBA function to make copies of a single PDF file. For example a file with the reference/name 1, I would need an amount x of copies lets say 1 to 10. In order to avoid coping and paste 9 times and renaming them manually I am sure there must be a function to do this job. I am very basic with VBA so any help would be much appreciated.
Many Thanks
First you will need to add a reference to Microsoft Scripting Runtime in the VBA editor. Then the following will work...
Public Sub Test()
CopyFile "C:\Users\randrews\Desktop\1.gif", "C:\Users\randrews\Desktop", 10
End Sub
Public Sub CopyFile(OriginalPath As String, DestinationFolderPath, Copies As Integer)
Dim fs As New FileSystemObject
For i = 1 To Copies
OrigName = fs.GetFileName(OriginalPath) 'file name with extention e.g. 1.gif
OrigNumber = CInt(Left(OrigName, Len(OrigName) - 4)) 'file name converted to a number - this will crash if the file name contains any non numeric chars
DestName = OrigNumber + i & "." & fs.GetExtensionName(OriginalPath) 'new file name = original number + i + the file extension
fs.CopyFile OriginalPath, DestinationFolderPath & "\" & DestName
Next i
End Sub
I have an Excel .xlam file that adds a button in the ribbon to do the following:
Scan the ActiveSheet for some pre-set parameters
Take my source text (a string value, hard coded directly in a VBA Module) and replace designated areas with the parameters retrieved from step 1
Generate a file containing the calculated text
I save the source text this way because it can be password protected and I don't need to drag another file around everywhere that the .xlam file goes. The source text is saved in a separate module called "Source" that looks something like this (Thanks VBA for not having Heredocs):
'Source Module
Public Function GetSource() As String
Dim s As String
s = ""
s = s & "This is the first line of my source text" & vbCrLf
s = s & "This is a parameter {par1}" & vbCrLf
s = s & "This is another line" & vbCrLf
GetSource = s
End Function
The function works fine. My problem is if I want to update the source text, I now have to manually do that in the .xlam file. What I would like to do is build something like a Sub ImportSource() in another module that will parse some file, rebuild the "Source" Module programatically, then replace that Module with my calculated source code. What I don't know is if/how to replace the source code of a module with some value in a string variable.
It's like metaprogramming at its very worst and philosophically I'm against doing this down to my very core. Practically, however, I would like to know if and how to do it.
I realize now that what you really want to do is store some values in your document in a way that is accessible to your VBA, but that is not readable to a user of the spreadsheet. Following Charles Williams's suggestion to store the value in a named range in a worksheet, and addressing your concern that you don't want the user to have access to the values, you would have to encrypt the string...
The "proper way" to do this is described in this article - but it's quite a bit of work.
A much shorter routine is found here. It just uses simple XOR encryption with a hard coded key - but it should be enough for "most purposes". The key would be "hidden" in your macro, and therefore not accessible to prying eyes (well, not easily).
Now you can use this function, let's call it encrypt(string), to convert your string to a value in the spreadsheet:
range("mySecretCell").value = encrypt("The lazy dog jumped over the fox")
and when you need to use it, you use
Public Function GetSource()
GetSource = decrypt(Range("mySecretCell").value)
End Function
If you use the XOR version (second link), encrypt and decrypt would be the same function...
Does that meet your needs better?
As #brettdj already pointed out with his link to cpearson.com/excel/vbe.aspx , you can programmatically change to code of a VBA module using the VBA Extensibility library! To use it, select the library in the VBA editor Tools->References. Note that you need to also change the options in your Trust center and select: Excel Options->Trust Center->Trust Center Settings->Macro Settings->Trust access to the VBA project object model
Then something like the following code should do the job:
Private mCodeMod As VBIDE.CodeModule
Sub UpdateModule()
Const cStrModuleName As String = "Source"
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Set VBProj = Workbooks("___YourWorkbook__").VBProject
'Delete the module
VBProj.VBComponents.Remove VBProj.VBComponents(cStrModuleName)
'Add module
Set VBComp = VBProj.VBComponents.Add(vbext_ct_StdModule)
VBComp.Name = cStrModuleName
Set mCodeMod = VBComp.CodeModule
'Add procedure header and start
InsertLine "Public Function GetSource() As String"
InsertLine "Dim s As String", 1
InsertLine ""
'Add text
InsertText ThisWorkbook.Worksheets("Sourcetext") _
.Range("___YourRange___")
'Finalize procedure
InsertLine "GetSource = s", 1
InsertLine "End Function"
End Sub
Private Sub InsertLine(strLine As String, _
Optional IndentationLevel As Integer = 0)
mCodeMod.InsertLines _
mCodeMod.CountOfLines + 1, _
Space(IndentationLevel * 4) & strLine
End Sub
Private Sub InsertText(rngSource As Range)
Dim rng As Range
Dim strCell As String, strText As String
Dim i As Integer
Const cLineLength = 60
For Each rng In rngSource.Cells
strCell = rng.Value
For i = 0 To Len(strCell) \ cLineLength
strText = Mid(strCell, i * cLineLength, cLineLength)
strText = Replace(strText, """", """""")
InsertLine "s = s & """ & strText & """", 1
Next i
Next rng
End Sub
You can "export" and "import" .bas files programmatically. To do what you are asking, that would have to be the approach. I don't believe it's possible to modify the code in memory. See this article