VBA: Get Excel FileDialogOpen to point to "My Computer" by default - vba

I'm trying to get excels save and open dialog boxes to open to "my computer" by default so the user can select a drive from there.
I have got the dialog boxes to open to any path on any drive or my documents etc but can't seem to find a way for it to open to my computer.
This is the code i'm using at the moment and it works fine for a known path:
MsgBox objFolders("desktop")
ChDrive objFolders("desktop")
ChDir objFolders("desktop")
strFileName = appRemoteApp.Workbooks("Export Template.xlsm").Application.GetSaveAsFilename(objFolders("desktop") & "\Replica Export " & UserName & " " & Format(Date, "yymmdd") & ".xlsm", FileFilter:="Excel Macro Enabled Workbook (*.xlsm), *.xlsm,")
Also, I have found this from this site.
If you paste ::{20D04FE0-3AEA-1069-A2D8-08002B30309D} into windows explorers address bar it takes you to my computer but if I use this in my VBA code
ChDir "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}"
it says it cant find the directory or something. So not sure if there is a work around for this or something.
This did not work either:
ChDir "C:\WINDOWS\explorer.exe /root,,::{20D04FE0-3AEA-1069-A2D8-08002B30309D}"
The reason i'm wanting to have the dialog boxs open to computer is that we will be hosting the excel doc on a windows server with access though RemoteApp and remote desktop. The users will not have access (rights) to the servers drives and folders etc, they will only have access to their own drives on their local machines which will be mapped and are visible under the servers "My Computer" folder for lack of a better word. The master document on the server generates a replica using VBA code and is then saved to the users local hard drive.

AFAIK there is no pure VBA solution to override the original behaviour. You can use an alternative from Robert Mearns answer but it doesn't show the windows form so it's less customizable.
Follow this answer if you want to achieve the exact effect - FileOpenDialog.
You can print all the environmental variables using the Environ$() function. This will not show any variable directly pointing to MyComputer therefore you can't pass it to the .InitialFileName property.
MyComputer is not a physical location that you can access through cmd. I think of it as an abstract Interface and it's quite difficult to explain how VBA and .InitialFileName uses a string to access a location.
Well, the only workaround the problem I can think of it's to use an external library written in for example C# that can access the MyComputer.
It's easier than it sounds!
Follow the below steps to create your Custom OpenFileDialog.
You need a Visual Studio Express For Desktop - it's free to download and use.
After installation - run as Administrator! (it's necessary for the libraries to get registered)
Select File and New Project. Rename it to CustomOFD and and hit the OK.
Right-click the CustomOFD Project in the Solution Explorer and Select Add References
Add references to the System.Windows.Forms as shown in the below img
Right-click Class1.cs in the Solution Explorer and rename it to CustomOFD.cs.
Double click your CustomOFD and replace the code with the one from below
using System;
using System.Runtime.InteropServices;
using System.Threading.Tasks;
using System.Windows.Forms;
namespace CustomOpenFileDialog
{
[InterfaceType(ComInterfaceType.InterfaceIsDual),
Guid("541EDD34-4CDC-4991-82E9-6FC23F904B5B")]
public interface ICustomOFD
{
DialogResult ShowDialog();
string FileName();
}
[ClassInterface(ClassInterfaceType.None)]
[Guid("E33102F0-B3C0-441C-8E7A-B9D4155A0D91")]
public class CustomOFD : ICustomOFD
{
private OpenFileDialog box = new OpenFileDialog();
public CustomOFD()
{
box.Multiselect = false;
box.Title = "Select file";
box.InitialDirectory = "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}";
}
public DialogResult ShowDialog()
{
return box.ShowDialog();
}
public string FileName()
{
return box.FileName;
}
}
}
Note: you can generate a new GUID for your own class using the Tools => Create GUID and replace it with your own, if you wanted to...
Right-click the CustomFileOpenDialog in the Solution Explorer and select Properties
In the Properties window go to Application tab and click Assembly Info and tick the Make COM-Visible box
Then go to the Build tab and tick Register for COM interop
Right-click the project and select Build from the menu
Now look in the Output tab as it shows you where the library was compiled to
usually its
c:\users\administrator\documents\visual studio 2012\Projects\CustomOpenFileDialog\CustomOpenFileDialog\bin\Debug\CustomOpenFileDialog.dll
Ok. Now save and close VS.
Open Excel and go into VBE ALT+F11 and insert a standard module
Click Tools on the menu bar and select References
Click the Browse button and navigate to the CustomOpenFileDialog.tlb file and click OK add to the list of references
Copy paste the code for module
Option Explicit
Sub Main()
Dim ofd As New CustomOFD
Set ofd = New CustomOFD
ofd.ShowDialog
Debug.Print ofd.Filename
End Sub
finally, run the sub and enjoy the computer as the default location for the customized OpenFileDialog box!

I cannot see a way to use the GetSaveAsFilename or similar dialogs to open on Computer or My Computer.
It is possible to prompt the user to select a folder using VB Script.
The root displayed is Computer and the user can select a folder.
The file can then be saved to the selected folder programatically.
Sub Test()
MsgBox BrowseForFolder(MyComputer)
End Sub
http://technet.microsoft.com/library/ee176604.aspx
Function MyComputer() As Variant
Dim objShell As Object, objFolder As Object
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace(&H11&)
MyComputer = objFolder.self.Path
Set objShell = Nothing
Set objFolder = Nothing
End Function
http://www.vbaexpress.com/kb/getarticle.php?kb_id=405
Function BrowseForFolder(Optional OpenAt As Variant) As Variant
Dim ShellApp As Object
Set ShellApp = CreateObject("Shell.Application"). _
BrowseForFolder(0, "Please choose a folder", 0, OpenAt)
On Error Resume Next
BrowseForFolder = ShellApp.self.Path
On Error GoTo 0
Set ShellApp = Nothing
End Function

.InitialFileName = "Computer"
Works for me with FileDialog(msoFileDialogFolderPicker)
Tested on Windows Vista - Excel 2007

Related

How to Link a VBA code with opened ETABS OAPI?

a project on ETABS 2015 is open on my PC. I want to do some change and process on it by a VBA code automatically. but all the sample code that I found was like this:
Public Sub Example()
Dim SapModel As cSapModel
Dim EtabsObject As cOAPI
Dim FileName as String
Dim ret As Integer = -1
'create ETABS object
EtabsObject = CreateObject("CSI.ETABS.API.ETABSObject")
'start ETABS application
ret = EtabsObject.ApplicationStart()
'create SapModel object
SapModel = EtabsObject.SapModel
'initialize model
ret = SapModel.InitializeNewModel()
'open an existing file - If no file exists, run the Save example first.
FileName = "c:\CSI_API_temp\example.edb"
ret = SapModel.File.OpenFile(FileName)
This code just open a new ETABS in my PC. but my ETABS project is already running and I want to connect to it but I don't know how!
please help me.
Your sample code is basically and typically the one needed to open ETABS ITSELF and to initialize a new model,
ETABSObject = CreateObject("CSI.ETABS.API.ETABSObject") followed by the invocation of ApplicationStart method are the direct means for that.
If you refer to the ETABS API documentation file in the installation destination (e.g "C:\Program Files\Computers and Structures\ETABS 2015\CSi API ETABS 2015.chm" ) Under the section "Release Notes>Attaching to a manually started instance of ETABS", or if you see the same section from the link
http://docs.csiamerica.com/help-files/etabs-api-2015/html/3ceb8889-9028-4de3-9c87-69a12055ade7.htm
you'll find code (in VB.Net) close to what you aim to, but it will not work with vba, so, what you will simply do is this
'The ret variable, just for method invocation convenience
Dim ret As Integer
'Create an instance of the currently opened Program
Dim myETABSObject As ETABS2015.cOAPI
Set myETABSObject = GetObject(, "CSI.ETABS.API.ETABSObject")
'Create an instance to the model
Dim myETABSModel As ETABS2015.cSapModel
Set myETABSModel = myETABSObject.SapModel
'Now, after the "reference instances" are obtained
'Initialize the model (using the model's instance of course)
ret = myETABSModel.InitializeNewModel() 'default units in kip_in_F
'Set the model templete, which is "Blank"
ret = myETABSModel.File.NewBlank()
And You can normally proceed in your coding.
Note: 1- GetObject(CSI.ETABS.API.ETABSObject) method will raise an error if ETABS is not opened.
2- you still can use GetObject even if ETABS is not opened and if you want to open it from windows shell (like using command prompt to open programs instead of double clicking on their respective icons), but this of course needs some Error Handling and the use of "Windows Script Host Object Model".
3- The examples in the documentation (under the documented methods and properties) may not be complete in terms of initiating input data, in cases like this they are just to create an impression of how to use their respective methods and properties.
The code below does as you asked. It uses VBA to connect to a currently running instance of ETABS. Please note if you're running multiple instances of ETABS it may not attach to the one you want.
You'll need to add a reference to 'ETABSv1.tlb' to your VBA project. If you're using VBA Editor for Excel, on the Tools menu select References, then click Browse then add C:\Program Files\Computers and Structures\ETABS 19\ETABSv1.tlb
Sub Main()
'create API helper object
Dim myHelper As ETABSv1.cHelper
Set myHelper = New ETABSv1.Helper
'dimension the ETABS Object as cOAPI type
Dim myETABSObject As ETABSv1.cOAPI
Set myETABSObject = Nothing
'attach to a running instance of ETABS
'get the active ETABS object
Set myETABSObject = myHelper.GetObject("CSI.ETABS.API.ETABSObject")
'get a reference to cSapModel to access all API classes and functions
Dim mySapModel As ETABSv1.cSapModel
Set mySapModel = myETABSObject.SapModel
' DO YOUR WORK BELOW.
MsgBox "Do your work here."
' DO YOUR WORK ABOVE.
'clean up variables
Set mySapModel = Nothing
Set myETABSObject = Nothing
Exit Sub
ErrHandler:
MsgBox "Cannot run API script: " & Err.Description
End Sub
ETABS comes with API documentation that you can find in the installation folder. On my machine it is here: C:\Program Files\Computers and Structures\ETABS 19\CSA API ETABS v1.chm

Outlook Not Running Visual Basic After Restart

So I have created a visual basic script in outlook that creates a random signature by pulling from Git.
The script works correctly but whenever I restart my machine the script doesn't run at all.
I fixed the issue by going to
"File"->"Options"->"Trust Center"->"Trust Center Settings..."->"Macro Settings"->"Enable all macros"
This let the VBA code work whenever I opened and closed Outlook but is there a better way to have the code work whenever I reopen Outlook or restart my machine.
I have tried to use
Private Sub Application_Startup()
MsgBox "Hi"
End Sub
While that code did work when I first put it in, whenever I restarted outlook it said it couldn't run because "Macros were disabled"
Here is my code for the random signature, anyway to have this work whenever I restart outlook or my machine? Or is the macro setting I edited the correct way to go?
Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
' Validate that the item sent is an email.
If Item.Class <> olMail Then Exit Sub
'These first variables is to find the file the .bat file created within the AppData folder
'Set enviro to %APPDATA%
Dim enviro As String
enviro = CStr(Environ("APPDATA"))
'Create a new variable that sets the file path for the RepoDir.txt
RepoPath = enviro & "\RepoDir.txt"
'Create a new variable to grab the line of text in RepoDir.txt
Dim RepoFilePath As String
Dim strFirstLine As String
'The new variable calls the RepoPath Variable, opens it and reads the first line of the file and copies it into a variable
RepoFilePath = RepoPath
Open RepoFilePath For Input As #1
Line Input #1, strFirstLine
Close #1
'The script runs a Shell command that opens the command line, cds to the Repo path within the str variable, does a git pull, and outputs the error level to a file in the temp directory
Shell ("cmd /c cd " & strFirstLine & " & git pull RandomSig & echo %ERRORLEVEL% > %TEMP%\gitPull.txt 2>&1")
'These second set of variables is to find the file the Shell command created within the TEMP folder
'Set enviro to %TEMP%
Dim Gitenviro As String
Gitenviro = CStr(Environ("TEMP"))
'Create a new variable that sets the file path for the RepoDir.txt
PullResult = Gitenviro & "\gitPull.txt"
'Create a new variable to grab the line of text in RepoDir.txt
Dim GitFilePath As String
Dim GitFirstLine As String
'The new variable calls the PullResult Variable, opens it and reads the first line of the file and copies it into a variable
GitFilePath = PullResult
Open GitFilePath For Input As #2
Line Input #2, GitFirstLine
Close #2
'MsgBox (GitFirstLine)
'The variable is checked to see if it does not equal 0, and if it doesn't the message is cancelled
If GitFirstLine <> 0 Then
MsgBox "There was an error when attempting to do the Git Pull, cancelling message"
Cancel = True
End If
Const SearchString = "%Random_Line%"
Dim QuotesFile As String
QuotesFile = strFirstLine & "quotes.txt"
If InStr(Item.Body, SearchString) Then
If FileOrDirExists(QuotesFile) = False Then
MsgBox ("Quotes file wasn't found! Canceling message")
Cancel = True
Else
Dim lines() As String
Dim numLines As Integer
numLines = 0
' Open the file for reading
Open QuotesFile For Input As #1
' Go over each line in the file and save it in the array + count it
Do Until EOF(1)
ReDim Preserve lines(numLines + 1)
Line Input #1, lines(numLines)
numLines = numLines + 1
Loop
Close #1
' Get the random line number
Dim randLine As Integer
randLine = Int(numLines * Rnd()) + 1
' Insert the random quote
Item.HTMLBody = Replace(Item.HTMLBody, SearchString, lines(randLine))
Item.HTMLBody = Replace(Item.HTMLBody, "%Random_Num%", randLine)
End If
End If
End Sub
Function FileOrDirExists(PathName As String)
Dim iTemp As Integer
On Error Resume Next
iTemp = GetAttr(PathName)
Select Case Err.Number
Case Is = 0
FileOrDirExists = True
Case Else
FileOrDirExists = False
End Select
On Error GoTo 0
End Function
It’s highly recommended to leave your macro security setting to only allow self-sign certificate Macros,
Do not use the Low option or run all
Create a self-signing certificate
Go to Start > All Programs > Microsoft Office > Microsoft Office Tools, and then click Digital Certificate for VBA Projects.
In the Your certificate's name box, type in name for the certificate.
Click OK. then SelfCert Success message will appears, click OK.
Go to Developer tab > click Visual Basic. or ALT+F11
In Visual Basic Editor, go to Tools > Digital Signature.
Digital Signature dialog appears and click on Choose and you’ll get a screen to select a certificate. Now you can choose the certificate you just created.
Edit
locating SelfCert.exe
Go to Start menu and typing VBA should bring up the SelfCert.exe.
Alternative method of locating SelfCert.exe
if you Can’t find it in the Start Menu? then By default you can find SelfCert.exe in the following location
Windows 32-bit
C:\Program Files\Microsoft Office\Office <version number>
Windows 64-bit with Office 32-bit
C:\Program Files (x86)\Microsoft Office\Office <version number>
Windows 64-bit with Office 64-bit
C:\Program Files\Microsoft Office\Office <version number>
Office 365 (Subscription based or Click-to-Run version of Office 2013)
C:\Program Files\Microsoft Office 15\root\office15
If SelfCert.exe is not installed
Then run Office setup and choose Add or Remove Features.
With older versions of Office you’ll need to choose Custom installation and then Advanced customization.
Expand the Office Shared Features section and select Digital Certificate for VBA Projects to run from your computer.
Simply run SelfCert.exe after locating it.

how to browse folder inside my project and explorer it

I have a 2form windows application one of them I want to use it like a Cylinder
(Programs and tools)
I am succeeded to add my file(and his sub folders) to my Resources
I named the button (ExeinfoPe
and these in Event of the button:
My.Computer.Audio.Play(My.Resources.Click1, AudioPlayMode.Background)
Dim appPath As String = My.Application.Info.DirectoryPath & "\" & "ExeinfoPe"
My.Computer.FileSystem.WriteAllBytes(appPath, My.Resources.ExeinfoPe, True)
Process.Start("ExeinfoPe\")
and this is the result is browser came with choose the application extension
and refused to browsed with explorer.exe
how can I explorer this folder who is inside my application
and can I moved in different application directory like (bin-release)

How to set a specific default directory for a Save As operation in VBA

We have a MS Access software which we need to be able to save a MS Word document from. It is not problem to get the save as dialog in word, using the VBA, but is it possible to get it to change the default directory to a path specified in the VBA? It just saves as on the desktop as default.
Edit: For the first answer:
You can use Application.FileDialog to ask the user for a path to save to:
Dim ofd As Office.FileDialog
Set ofd = Application.FileDialog(msoFileDialogSaveAs)
ofd.Title = "Save As..."
ofd.InitialView = msoFileDialogViewList
ofd.InitialFileName = "c:\temp\myfile"
' Show Dialog and abort if user clicks cancel:
If (ofd.Show = 0) Then Exit Sub
MsgBox ofd.SelectedItems(1) ' shows the selected filename
Use that path to directly save the word document.
You can just add the filename you would like to the dialog as such:
Application.GetSaveAsFilename("c:\temp\myfile")
This will open the dialog in the temp folder and suggest myfile as name for the file.
See here for other modify-able stuff in the dialog: https://msdn.microsoft.com/en-us/library/office/ff195734%28v=office.15%29.aspx

VB.net Save File Dialogue error - Could not find special directory 'Desktop'

I have a fairly straight forward peice of code that just tries to set the default saved directory for a standard .net save dialogue to a specific folder. If that folder doesn't exist, it sets it to the desktop.
This works fine for everyone but one user who is getting the following error:
Could not find special directory 'Desktop'
How is that even possible?
'Check if folder exists
If Not IO.Directory.Exists(strDirectory) Then
strDirectory = FileIO.SpecialDirectories.Desktop
If Not IO.Directory.Exists(strDirectory) Then
strDirectory = IO.Directory.GetCurrentDirectory
End If
End If
'Show save file dialogue.
Dim folderDlg As New Windows.Forms.FolderBrowserDialog
folderDlg.RootFolder = Environment.SpecialFolder.Desktop
folderDlg.SelectedPath = strDirectory
folderDlg.ShowNewFolderButton = True
How about:
strDirectory = _
Environment.GetFolderPath(Environment.SpecialFolder.Desktop).ToString()
I use GetFolderPath() to get "My Documents" and it works fine (I don't ever have to think about it).