I have an Excel file with VBA written on it that draws information from a file on my computer. The Excel file is on a network folder and I would like for other users on the network to use it as well. However, I have hardcoded the file path on the VBA and, as such, whenever another user opens it, it looks for a file that is not available.
This is the path I would like to change:
C:\Users\User1\Documents\The Market in\DATA FOR REPORTS.xlsx
The only difference on the paths would be the user's name: User1, user2, etc.
How can I write the VBA code in order for it to replace the username in the file path with the Windows user name opening it?
I have tried to use wild card and also tried to use ENVIRON("username") but have not been successful.
The code I want to replace is what's below:
Private Sub Workbook_Open()
Application.Visible = False
WelcomeForm.Show
Workbooks.Open ("C:\Users\User1\Documents\The Market in\DATA FOR REPORTS.xlsx")
End Sub
This is what I did using ENVIRON:
Private Sub Workbook_Open()
Dim username As String
username = Environ("username")
Application.Visible = False
WelcomeForm.Show
Workbooks.Open ("C:\Users\&username&\Documents\The Market in\DATA FOR REPORTS.xlsx")
End Sub
Thank you very much
Try something like this:
Private Sub Workbook_Open()
Application.Visible = False
WelcomeForm.Show
Workbooks.Open ("C:\Users\" & Environ("UserName") & "\Documents\The Market in\DATA FOR REPORTS.xlsx")
End Sub
Environ("userprofile") will return the path & username.
On my PC it returns C:\Users\darren.bartrup-cook
Another way is:
CreateObject("WScript.Shell").SpecialFolders("MyDocuments")
On my PC this returns C:\Users\darren.bartrup-cook\Documents
You could use it like this:
Private Sub Workbook_Open()
Dim wrkBK As Workbook
Dim DocFldr As String
DocFldr = CreateObject("WScript.Shell").SpecialFolders("MyDocuments")
Set wrkBK = Workbooks.Open(DocFldr & "\The Market in\DATA FOR REPORTS.xlsx")
MsgBox wrkBK.Name & " is open", vbOKOnly + vbInformation
End Sub
Related
I'm attempting to use this code found here:
https://answers.microsoft.com/en-us/msoffice/forum/all/can-i-save-as-multiple-documents-at-one-time/eae10efb-1984-4131-b072-a96d45020ba9
Sub SaveAllOpenDocsAsDocx()
For Each aDoc In Application.Documents
aDoc.SaveAs FileName:=aDoc.FullName & ".doc", FileFormat:=wdFormatDocument
aDoc.Close
Next aDoc
End Sub
I'd like to save any open word documents to a specific folder path, how would I go about changing
FileName:=aDoc.FullName
to a specific locations e.g. C:\Users\joe.blog\Desktop\Backup
Using FullName property includes the original path.
You need to pull out the Filename using the Name property and append that to your path
Something like this
Sub SaveAllOpenDocsAsDocx()
Const MY_LOCATION = "C:\Users\joe.blog\Desktop\Backup\"
Dim myFileLocation As String
For Each aDoc In Application.Documents
myFileLocation = MY_LOCATION & aDoc.Name & ".doc"
aDoc.SaveAs FileName:=myFileLocation, FileFormat:=wdFormatDocument
aDoc.Close
Next aDoc
End Sub
Is it possible to build something like AutoOpen but less generic? So I mean a macro, which executes when you open file xyz.docx.
Please, copy the next code in "Normal.dotm" "ThisDocument" code module:
Option Explicit
Const docName = "xyz.docx" 'use here the document name you need
Private Sub Document_Open()
If ActiveDocument.Name = docName Then
MsgBox ActiveDocument.Name & " has been opened..."
End If
End Sub
The Open event is triggered for any document being open.
Here's a sample macro that automatically runs when the document opens. This sample checks whether the user is trying to open a template for editing, then it creates a new document based on the template instead. (Bypass the macro by holding down Shift while you open the file).
This sample only makes sense when placed in a macro-enabled template, but you could also add something like this to a macro-enabled document. The document location would also have to be made a trusted location in Windows.
Sub AutoOpen()
Dim PathTemp$, NameTemp$
If ActiveDocument.Type = wdTypeTemplate Then
NameTemp$ = ActiveDocument.Name
PathTemp$ = ActiveDocument.Path
Documents.Add Template:=PathTemp$ & Application.PathSeparator & NameTemp$
For Each fWindow In Application.Windows
If fWindow.Caption = NameTemp$ Then
fWindow.Close SaveChanges:=wdDoNotSaveChanges
End If
Next fWindow
End If
End Sub
I currently use the following code to force the user to save the file as a macro enabled workbook.
Application.Dialogs(xlDialogSaveAs).Show , xlOpenXMLWorkbookMacroEnabled
The problem is, if the user presses the "Cancel" button, the code continues on. I need to it to stop if the "Cancel" button is pressed.
Any help is appreciated.
Thanks.
You will have to capture the event when the cancel button is clicked.
Sub saveasxml()
Dim userResponce As Boolean
On Error Resume Next
userResponce = Application.Dialogs(xlDialogSaveAs).Show("Test name", 52)
On Error GoTo 0
If userResponce = False Then
MsgBox "Cancel clicked"
Exit Sub
Else
MsgBox "You saved file "
End If
End Sub
This page has a nice example that explains what you need to do:
http://codevba.com/excel/dialogs.htm#SaveAs
Essentially, it's like this:
' Application.Dialogs(xlDialogSaveAs).Show returns
' True or False depending on whether the user canceled or not
If Application.Dialogs(xlDialogSaveAs).Show Then
' User saved
Else
' User canceled
End If
Taking a more complete example from the link above and modifying it slightly to your purposes:
Sub thing()
Dim strFilename As String: strFilename = "report1"
Dim strFolder As String: strFolder = "C:\temp\" 'initial directory - NOTE: Only works if file has not yet been saved!
'Dim xlfFileFormat As XlFileFormat: xlfFileFormat = XlFileFormat.xlOpenXMLWorkbook 'or replace by other XlFileFormat
Dim xlfFileFormat As XlFileFormat: xlfFileFormat = XlFileFormat.xlOpenXMLWorkbookMacroEnabled 'or replace by other XlFileFormat
Dim strPassword As String: 'strPassword = "password" 'The password with which to protect the file - if any
Dim booBackup As Boolean: 'booBackup = True '(Whether to create a backup of the file.)
Dim strWriteReservationPassword As String: 'strWriteReservationPassword = "password2" ' (The write-reservation password of the file.)
Dim booReadOnlyRecommendation As Boolean: booReadOnlyRecommendation = False '(Whether to recommend to the user that the file be opened in read-only mode.)
Dim booWorkbookSaved As Boolean ' true if file saved, false if dialog canceled
If Len(strFolder) > 0 Then ChDir strFolder
booWorkbookSaved = Application.Dialogs(xlDialogSaveAs).Show(Arg1:=strFilename, Arg2:=xlfFileFormat, Arg3:=strPassword, _
Arg4:=booBackup, Arg5:=strWriteReservationPassword, Arg6:=booReadOnlyRecommendation)
If Not booWorkbookSaved Then
Exit Sub
End If
MsgBox "Workbook saved"
End Sub
Let's assume I have 2 different files: "1" and "a1".
I want to open second one using macro from "1" and then run a code from "a1"
So, in "1" I have following code:
Sub anotherMacro()
Dim path As String
Dim Fname As String
Dim macroName As String
path = ActiveWorkbook.path
Fname = ActiveWorkbook.Name
Workbooks.Open (path & "\a" & Fname)
Application.Run "a1.xlsm!Module1.SecondMacro"
MsgBox "Am I still here?"
End Sub
Second macro in file "a1" looks like that:
Sub SecondMacro()
ActiveWorkbook.Close
End Sub
When I'm using Application.Run command, the msgbox is not being executed. The "a1" is getting opened, closed and then there is no further action.
Is there a way to get back to "1" and display the msgbox?
If you put your VBA code in an XLAM file instead of an XLSM file, then you can add it as an Excel Add-In and it can then communicate with all workbooks simultaneously.
I notice that after executing Workbook.Close, the VBA stops executing. Therefore, you should be careful of codes placed after the Workbook.Close.
You may consider transfer the Workbook.Close method to 1.xlsm. Perform any actions before you execute the Workbook.Close method.
I modified the codes as follows.
1.xlsm
Module1
Option Explicit
Sub anotherMacro()
Dim path As String
Dim Fname As String
Dim macroName As String
With Application
path = .ThisWorkbook.path
Fname = .ThisWorkbook.Name
.Workbooks.Open (path & "\a" & Fname)
.Run "a1.xlsm!Module1.SecondMacro"
End With
End Sub
Sub WelcomeBack()
MsgBox "Am I still here?"
Application.ThisWorkbook.Activate
' Activate 1.xlsm. This is optional, depending on your needs.
' Add code here to perform any further actions.
Application.Workbooks("a1.xlsm").Close
' Close a1.xlsm. VBA stops here.
End Sub
a1.xlsm
Module1
Option Explicit
Sub SecondMacro()
' Add code here to perform any actions.
Application.Run "1.xlsm!Module1.WelcomeBack"
' Go back to 1.xlsm
End Sub
PS: Check out the difference between Application.ActiveWorkbook and Application.ThisWorkbook.
I would like to export/ maintain/ manage a text file backup of modules in my personal macro workbook personal.xlsb using VBA.
I cannot find an object library which refers to the modules themselves on msdn. Could someone point me in the right direction on this please?
Using Excel 2013.
You need to add Visual Basic for Application Extensibility X.X reference; or:
Sub load_reference_1()
ThisWorkbook.VBProject.References.AddFromGuid "{0002E157-0000-0000-C000-000000000046}", 5, 3
end sub
Sub Load_reference_2()
ThisWorkbook.VBProject.References.AddFromFile "C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
end sub
Example:
Sub Macromodule_copy1()
ThisWorkbook.VBProject.VBComponents("Macroos").Export "E:\Macroos.bas"
With Workbooks.Add
.VBProject.VBComponents.Import "E:\Macroos.bas"
End With
End Sub
Further examples and source: Snb-Vba -awesome examples!-
I do exactly this, with my personal.xlsb and also with other macro workbooks.
I save the text files into a "VBA" subdirectory and put them into version control to keep track of the changes.
I was inspired by Mass importing modules & references in VBA which references https://www.rondebruin.nl/win/s9/win002.htm
I have a module called WriteBas containing this code:
Attribute VB_Name = "WriteBas"
Option Explicit
Sub WriteAllBas()
' Write all VBA modules as .bas files to the directory of ThisWorkbook.
' Implemented to make version control work smoothly for identifying changes.
' Designed to be called every time this workbook is saved,
' if code has changed, then will show up as a diff
' if code has not changed, then file will be same (no diff) with new date.
' Following https://stackoverflow.com/questions/55956116/mass-importing-modules-references-in-vba
' which references https://www.rondebruin.nl/win/s9/win002.htm
Dim cmp As VBComponent, cmo As CodeModule
Dim fn As Integer, outName As String
Dim sLine As String, nLine As Long
Dim dirExport As String, outExt As String
Dim fileExport As String
On Error GoTo MustTrustVBAProject
Set cmp = ThisWorkbook.VBProject.VBComponents(1)
On Error GoTo 0
dirExport = ThisWorkbook.Path + Application.PathSeparator + "VBA" + Application.PathSeparator
For Each cmp In ThisWorkbook.VBProject.VBComponents
Select Case cmp.Type
Case vbext_ct_ClassModule:
outExt = ".cls"
Case vbext_ct_MSForm
outExt = ".frm"
Case vbext_ct_StdModule
outExt = ".bas"
Case vbext_ct_Document
Set cmo = cmp.CodeModule
If Not cmo Is Nothing Then
If cmo.CountOfLines = cmo.CountOfDeclarationLines Then ' Ordinary worksheet or Workbook, no code
outExt = ""
Else ' It's a Worksheet or Workbook but has code, export it
outExt = ".cls"
End If
End If ' cmo Is Nothing
Case Else
Stop ' Debug it
End Select
If outExt <> "" Then
fileExport = dirExport + cmp.name + outExt
If Dir(fileExport) <> "" Then Kill fileExport ' From Office 365, Export method does not overwrite existing file
cmp.Export fileExport
End If
Next cmp
Exit Sub
MustTrustVBAProject:
MsgBox "Must trust VB Project in Options, Trust Center, Trust Center Settings ...", vbCritical + vbOKOnly, "WriteAllBas"
End Sub
and in my ThisWorkbook object, the BeforeSave event handler calls it each time the workbook is saved.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
WriteAllBas
End Sub
There's a second or two of overhead each time the workbook is saved.
Note: Under Office 2016 and earlier versions I didn't need to delete (Kill) the text file before exporting, but under Office 365 the Export method fails if the file exists.
I just save a date/timestamped copy of PERSONAL.xlsb to a backup drive location using the following code.
Sub PersonalBckup()
Const dstBak As String = "H:\PERSONAL MACROS\" 'change path to suit
Const dstBak2 As String = "D:\PERSONAL Macros\"
On Error Resume Next 'if either of the drives are not present, skip error.
Application.DisplayAlerts = False 'turn off warning popups
With Workbooks("PERSONAL.xlsb") 'name of your PERSONAL.xlsb file
.SaveCopyAs dstBak & "PERSONAL" & " as of " & Format(Now(), "YYYYMMDD_hhmmAMPM") & ".xlsb"
.SaveCopyAs dstBak2 & "PERSONAL" & " as of " & Format(Now(), "YYYYMMDD_hhmmAMPM") & ".xlsb"
.Save
End With
Application.DisplayAlerts = True 'Turn on warning popups
The backed-up file is saved with a date/timestamp: "PERSONAL as of 20180512_0136PM.xlsb"
I know this doesn't exactly answer the question, but perhaps it's still helpful. You can easily save all modules into a pdf by rigth clicking the modules folder and clicking print (and then clicking setup to change to print to pdf) . This won't give you a specific exported file that can be easily imported back in per se, but it keeps a safely saved file that you can always go back and reference should anything go wrong in your code. There's probably a way to automate this (or at least make it a one-time click when you save), but I haven't figured that out yet.