I would like to automatically create a shortcut to the current's folder on the user's desktop. Some users I'm working with don't know how to create shortcuts or how to drag and drop a folder. I just want to create a file named "CLICK ME TO CREATE A SHORTCUT TO THIS FOLDER ON YOUR DESKTOP" that will work in any folder I want.
For example, if I run C:\myRandomFolder\CLICK ME.whatever, I want it to create a shortcut to "C:\myRandomFolder\" named "myRandomFolder" on "D:\Documents and Settings\%username%\Desktop".
I'm wondering if I'm better using a batch file (.bat), VB Script (.vbs) or any other scripting language to do so. What would be the easiest and better way of doing it?
The best way finally seems to be a VBS Script. Here is what I finally got working right:
Option Explicit
On Error Resume Next
Private WshShell
Private strDesktop
Private oShellLink
Private aSplit
set WshShell = WScript.CreateObject("WScript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")
aSplit = Split(WScript.ScriptFullName, "\")
set oShellLink = WshShell.CreateShortcut(strDesktop & "\" & aSplit(Ubound(aSplit) - 1) & ".lnk")
oShellLink.TargetPath = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
oShellLink.WindowStyle = 1
oShellLink.Description = "Shortcut Script"
oShellLink.WorkingDirectory = Replace(WScript.ScriptFullName, WScript.ScriptName, "")
oShellLink.Save
MsgBox "Shortcut to " & Replace(WScript.ScriptFullName, WScript.ScriptName, "") & " added yo your desktop!"
Great code! Out of curiosity, since this works for the directory the script is currently in, do you have a way to get it to show up in every directory? Otherwise, it doesn't seem like there's much difference between learning this and learning to make a shortcut the native way. You would still have to drag and drop the script into the current folder, wouldn't you?
While stumbling toward a solution, I got as far as letting users navigate to and select a particular file they need to link to. I don't know if you would have any use for that.
Dim diaSelectFile
Set diaSelectFile = Application.FileDialog(msoFileDialogFilePicker)
diaSelectFile.Show
strPickedFile = diaSelectFile.SelectedItems(1)
Set diaSelectFile = Nothing
Dim oWsh
Dim myshortcut
Dim oShortcut
Dim strSplitFileName
Dim strTarget
Dim nShortName
Set oWsh = CreateObject("WScript.Shell")
strSplitFileName = Split(strPickedFile, "\")
nShortName = UBound(strSplitFileName)
strTarget = strSplitFileName(nShortName)
myshortcut = "C:\users\%USERNAME%\Desktop\" & strTarget & " - Shortcut" & ".lnk"
Set oShortcut = oWsh.CreateShortcut(myshortcut)
With oShortcut
.TargetPath = strPickedFile
.Save
End With
Set oWsh = Nothing
Set oShortcut = Nothing
Again, though, this feels more complex than right-clicking and sending a shortcut to the desktop. Who are the users that need this? I know I've had austistic friends who struggle with what we might consider basic tasks on the computer. I'd definitely be interested to know if the script you came up with actually helps your clientele.
Related
I have a situation that is really flummoxing me. Simple code I've used for years is failing in the weirdest way. I have a feeling the cause is related to either anti-virus junk or GPO, but, even those, I have seen them operate before on this scenario--but nothing like how I am seeing it now.
Note - this code has been working perfectly for several people, until one end-user got a new Surface laptop from I.T., purportedly for better compatibility with Teams and 365. ALL users (working, non-working) are on Windows 10.
Scenario:
I'm using Scripting.Filesystemobject
setting an object variable (Textstream intent), as fso.createtextfile
The filepath (name) I am creating is actually filename.vbs...At the moment this line executes, I can see the vbs file successfully in the folder
I use Textstream.Write to put some content in the file
I then use Textstream.Close (normally at this point you get a solid, stable, useable file). Immediately upon execution of the last line, Textstream.Close, the file DISAPPEARS from the folder-GONE.
The folder I'm writing to is the same as Start > Run > %appdata%
I've also tried this in Documents folder (Environ$("USERPROFILE") & "\My Documents") and get the exact same result
I've seen group policies and AV stuff that will prevent VBS from running, but that isn't my case--I've tested with this user, and she has no problem:
Creating a txt file in either of those folders
Manually creating a .vbs file in either of those folders
Even RUNNING the resulting vbs file in either folder
But somehow when I programmatically create .VBS in code, the second I close the textstream, the file is gone from the folder.
Any insight? The internet searches I did were void of all information on this scenario!! It would take me 2 weeks to open a ticket and get any help from I.T.
This is Excel VBA, but I highly doubt the problem has anything to do with Excel nor VBA...this is standard usage of windows scripting.filesystemobject:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
'initiate full backup vbs script:
Dim ts As Object, fso As Object, strScriptText As String, strScriptPath As String
'populate our variable with the full text of the script: found on QLoader in this range:
strScriptText = ThisWorkbook.Worksheets("QLoader").Range("z_BackupScriptText").Value
'replace the text "placeholder" with this workbook's actual full path/name:
strScriptText = Replace(strScriptText, "placeholder", ThisWorkbook.FullName)
'fire up FSO:
Set fso = CreateObject("scripting.filesystemobject")
'determine the new VBS file's path
strScriptPath = Environ("AppData") & "\Backup_" & Format(Now, "yymmddhhmmss") & ".vbs"
'create our textstream object:
Set ts = fso.createtextfile(strScriptPath)
'write our script into it
ts.write strScriptText
'save and close it
ts.Close 'RIGHT HERE THE FILE DISAPPEARS FROM THE FOLDER ***********
'GO:
Shell "wscript " & strScriptPath, vbNormalFocus
End Sub
It does look like an antivirus thing...
If the issue is just the vbs extension though, you can use something like this:
Sub tester()
Dim ts As Object, fso As Object, strScriptText As String, strScriptPath As String
Set fso = CreateObject("scripting.filesystemobject")
strScriptPath = Environ("AppData") & "\Backup_" & Format(Now, "yymmddhhmmss") & ".txt"
Set ts = fso.createtextfile(strScriptPath)
ts.write "Msgbox ""Hello"""
ts.Close
'need to specify the script engine to use
Shell "wscript.exe /E:vbscript """ & strScriptPath & """ ", vbNormalFocus
End Sub
I am not a programmer so not sure what to do here. I would like an option of adding an image file in a Microsoft Word document userform for MAC. I had used a code earlier which works perfectly in Windows but it doesnt work for MAC and gives a 5948 error. I had added a field for the image in the userform with a button to add the image and the final submit button. The add button should allow the user to insert any size image from the local folder.
The code I was using is given below:
Dim ImagePath As String
Private Sub CMDAddImage_Click()
Dim objFileDialog As Office.FileDialog
Set objFileDialog = Application.FileDialog(MsoFileDialogType.msoFileDialogFilePicker)
With objFileDialog
.AllowMultiSelect = False
.ButtonName = "File Picker"
.Title = "File Picker"
If (.Show > 0) Then
End If
If (.SelectedItems.Count > 0) Then
Call MsgBox(.SelectedItems(1))
ImagePath = .SelectedItems(1)
End If
End With
Image1.Picture = LoadPicture(ImagePath)
End Sub
And the code in submit button was:
Dim objWord
Dim objDoc
Dim objShapes
Dim objSelection
'Set objSelection = ActiveDocument.Sections
'objSelection.TypeText (vbCrLf & "One Picture will be inserted here....")
ActiveDocument.Bookmarks("Field04").Select
Set objShapes = ActiveDocument.InlineShapes
objShapes.AddPicture (ImagePath)
End
End Sub
Can someone please help me edit the code for mac. In mac it does not allow to add the file.
You should check out the suggestion made by #JohnKorchok in a comment to your previous question - insert an image Content Control in your document instead, and throw away the VBA.
But if you need to keep using VBA and a UserForm...
Application.FileDialog is not available on Mac.
Application.GetOpenFileName is not avaialble from Word (it's an Excel thing).
Application.Dialogs does not do the same thing as GetOpenFileName so the user experience will be rather different, but at its simplest, you can use it like this:
With Application.Dialogs(wdDialogFileOpen)
' .Display = -1 for "OK" ("Open" in this case)
' .Display = 0 for "Cancel"
' (THere are other possible return values
' but I do not think they are applicable here)
If .Display = -1 Then
ImagePath = .Name
End If
End With
or if you prefer, the lengthier
Dim dlg As Word.Dialog
Set dlg = Application.Dialogs(wdDialogFileOpen)
With dlg
If .Display = -1 Then
ImagePath = .Name
End If
End With
Set dlg = Nothing
However, this dilaog does not let you specify file types or any kind of filtering, a starting folder etc. Attempts to set Finder search criteria via something like
.Name = "(_kMDItemFileName = ""*.jpg"")"
.Update
before the .Display either can't work or need different syntax.
Further, the Apple dialog may start with its
own filtering set up so the user will have to click Options to enable All Files. You don't know what file type the user will choose so you will need to deal with that.
An alternative is to invoke Applescript. For this, it appears that you can still use the VBA MacScript command, which means that you can put all the script in your VBA file. If that does not work, then unfortunately you have to use AppleScriptTask which would require you to work some more on the Script and install the script in the correct folder on every Mac where you need this feature.
Here's the code I used - you would probably need to wrap everything up in another function call and use conditional compilation or other tests to call the correct routine depending on whether the code is running on Mac or Windows
Private Sub CMDAddImage_Click()
Dim s As String
Dim sFileName As String
On Error Resume Next
s = ""
' set this to some other location as appropriate
s = s & "set thePictureFoldersPath to (path to pictures folder)" & vbNewLine
s = s & "set applescript's text item delimiters to "",""" & vbNewLine
s = s & "set theFile to ¬" & vbNewLine
' add the image file types you want here
s = s & "(choose file of type {""png"",""jpg""} ¬" & vbNewLine
s = s & "with prompt ""Choose an image to insert."" ¬" & vbNewLine
s = s & "default location alias thePictureFoldersPath ¬" & vbNewLine
s = s & "multiple selections allowed false) as string" & vbNewLine
s = s & "set applescript's text item delimiters to """"" & vbNewLine
' choose file gives as an AFS path name (with colon delimiters)
' get one Word 2016/2019 will work with
s = s & "posix path of theFile"
sFileName = MacScript(s)
If sFileName <> "" Then
' Maybe do some more validation here
ImagePath = sFileName
Image1.Picture = LoadPicture(ImagePath)
End If
End Sub
I spend hours finding the problem.
I want to start the SAP Logonpad with the ini file, that works fine.
Then after binding to the scripting object I want to open the connection to a specific System with connection = SapGui.OpenConnection("SID", True)
but always get runtime error 70 access denied.
I followed what others seem to do with vbs, for certain resons I can't do it with vbs and have to go with vba, so maybe there might be some difference that makes it fail?
Any advice would be highly appreciated.
Private Sub CommandButton1_Click()
Dim SapGui As Object
Dim saplogon As Object
Dim connection 'As Object
Set SapGui = GetObject("SAPGUI")
Dim Wshshell As Object
Set Wshshell = CreateObject("Wscript.Shell")
Wshshell.Run Chr(34) & ("C:\Program Files\SAPPC\FrontEnd\SAPgui
\saplogon.exe") & Chr(34) & " " & "/INI_FILE" & "=" & Chr(34) &
"\\longpathtoini\appl\Sap\saplogon\int\saplogon.ini" & Chr(34)
Do Until Wshshell.AppActivate("SAP Logon")
Application.Wait Now + TimeValue("0:00:01")
Loop
Set Wshell = Nothing
Set saplogon = SapGui.GetScriptingEngine
connection = SapGui.OpenConnection("SID", True)
Set SapGui = Nothing
Set saplogon = Nothing
Set connection = Nothing
End Sub
Check whether user scripting is allowed for the particular system (transaction RZ11, parameter sapgui/user_scripting). Also be aware that for some versions, you'll apparently need to specify the SAP Logon entry text instead of the SID.
Thanks to vwegert.
I surely knew about scripting needs to be enabled on the servers.
Which is, but at the moment I read his answer I remembered that in my SAP GUI settings the checkbox for "Warn if a script tries to connect" was enabled.
Disabeling that options did lead to success.
The above code works perfectly.
My workplace is rolling out some large updates for Microsoft office. I'm trying to set up a VBA macro to run on everyone's computer to create a new folder with copies of Normal.dotm so that if (God forbid) something goes wrong we can restore the Normal.dotm. This is important because EVERYONE has a different ribbon layout and different macros and settings that we don't want lost.
My problem is I have a macro that is functionally fine, however when i try it on the Normal.dotm it gives the Permission Denied error because the FileCopy funtion cant work on Normal.dotm.
Code:
Private Sub CopyFiles_Click()
sUserName = Environ$("username")
Dim BackupDir As String
BackupDir = "C:\Users\" + sUserName + "\Desktop\Backup for Normal - DO NOT DELETE"
If FileFolderExists(BackupDir) Then
Else
MkDir BackupDir
End If
If FileFolderExists("C:\Users\" + sUserName + "\AppData\Roaming\Microsoft\Templates\Normal.dotm") Then
FileCopy "C:\Users\" + sUserName + "\AppData\Roaming\Microsoft\Templates\Normal.dotm", (BackupDir + "\Normal.dotm")
End If
End Sub
I have a function for "FileFolderExists" i just didn't include it to save space (it works fine)
My question is, is there any way to work around this (Been searching for a while and have come up empty handed), or is there a better way to do this?
Try this VBScript (Not VBA)
Dim sUserName
sUserName = CreateObject("WScript.Network").UserName
Dim BackupDir
BackupDir = "C:\Users\" + sUserName + "\Desktop\Backup for Normal - DO NOT DELETE"
dim filesys
set filesys=CreateObject("Scripting.FileSystemObject")
on error resume next
filesys.CreateFolder BackupDir
on error goto 0
filesys.CopyFile "C:\Users\" & sUserName & "\AppData\Roaming\Microsoft\Templates\Normal.dotm", (BackupDir & "\Normal.dotm")
I made a script that copying a file to a certain location.
I add the .vbs to taskschd.msc scheduled for make a .pst backup
but I get error message
Line: 91
Char: 7
Error: Permission denied
Code: 800A0046
Source: Microsoft VBScript runtime error
<pre>
'Set the amount of pst-files you want to copy. Start counting at 0!
ReDim pst(1)
'Define the location of each pst-file to backup. Increase the counter!
pst(0) = "C:\Users\daniel.elmnas.TT\Documents\Outlook Files\de#teknotrans.se.pst"
pst(1) = "C:\Users\daniel.elmnas.TT\Documents\Outlook Files\de.pst"
'Define your backup location
BackupPath = "\\ttad-1\Gemensam\Outlook_Backup\Daniel Elmnäs"
'Keep old backups? TRUE/FALSE
KeepHistory = FALSE
'Maximum time in milliseconds for Outlook to close on its own
delay = 30000 'It is not recommended to set this below 8000
'Start Outlook again afterwards? TRUE/FALSE
start = TRUE
'===================STOP MODIFY====================================
'Close Outlook
Call CloseOutlook(delay)
'Outlook is closed, so we can start the backup
Call BackupPST(pst, BackupPath, KeepHistory)
'Open Outlook again when desired.
If start = TRUE Then
Call OpenOutlook()
End If
Sub CloseOutlook(delay)
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
'If Outlook is running, let it quit on its own.
For Each Process in objWMIService.InstancesOf("Win32_Process")
If StrComp(Process.Name,"OUTLOOK.EXE",vbTextCompare) = 0 Then
Set objOutlook = CreateObject("Outlook.Application")
objOutlook.Quit
WScript.Sleep delay
Exit For
End If
Next
'Make sure Outlook is closed and otherwise force it.
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'Outlook.exe'")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
Set objWMIService = Nothing
Set objOutlook = Nothing
set colProcessList = Nothing
End Sub
Sub BackupPST(pst, BackupPath, KeepHistory)
Set fso = CreateObject("Scripting.FileSystemObject")
If KeepHistory = True Then
ArchiveFolder = Year(Now) & "-" & Month(Now) & "-" & Day(Now)
BackupPath = BackupPath & ArchiveFolder & "\"
End If
If fso.FolderExists(BackupPath) = False Then
fso.CreateFolder BackupPath
End If
For Each pstPath in pst
If fso.FileExists(pstPath) Then
fso.CopyFile pstPath, BackupPath, True
End If
Next
Set fso = Nothing
End Sub
Sub OpenOutlook()
Set objShell = CreateObject("WScript.Shell")
objShell.Run "Outlook.exe"
End Sub
</pre>
Could someone help me to solve this?
Thank you in advance
Seems like you schedule the script.
You need to start the task with a user that executes the script which has rights on the PST file, as well as on the path where you store the backup. Running it with the system account won't be enough.
There are better ways to backup PST files also, I use a Ruby script to synchronise a local copy with a backup copy, is runs on PST's more than 10GB big without problem, might be a problem if you would do it with a copy like this.
You need to backup the copy on a backup medium also because when the PST has errors (and all big PST have) you copy the errors to the backup and could lose both.
Also, you do the following
BackupPath = "\\ttad-1\Gemensam\Outlook_Backup\Daniel Elmnäs"
...
BackupPath = BackupPath & ArchiveFolder & "\"
Where is the \ between the two first variables ?
EDITED: Change the permissions of the folder.
In windows explorer, navigate to the folder where the PST file is located.
In the left pane of windows explorer, right click on the folder where the PST file is located, select "Properties".
Select the "Security" tab
Click the button "Edit" to change permissions.
Click "Add"
In the object names to select box, enter "everyone" (no quotes).
Click "Check Names", everyone should become capitalized and underlined.
Click "Ok"
Select "Everyone" from the list of Groups or user names.
In the "Permissions for Everyone" list, make sure "Read & Execute, List folder contents and Read, in the allow column are checked, click "Apply"
Click Ok.
NOTE: By doing this, anyone who has access to this computer can access the folder. You might consider only adding your login to the computer to the list of Groups or usernames instead of Everyone. You may have to repeat the above steps on the PST file(s) in question.
Original Post:
I ran the script here, testing for various issues and it ran without problems. At this point I believe the issue is rights and permissions to either the source or destination folder (or the files you are backing up). By default, the user's themselves don't have access to Outlooks data files. You would need to add "read" permissions to the files in question (PST,OST, and so on) or the full folder.
In reality, just backing up the PST files isn't enough to restore an Outlook configuration; you would need all of the files.
You can Try this:
'===================================================================
'Description: VBS script to backup your pst-files.
'
'Comment: Before executing the vbs-file, set the location of outlook
' folder you want to backup and
' the backup location (this can also be a network path).
' See the URL below for more configuration instructions and
' how to create a Scheduled Task for it.
'
' Original author : Robert Sparnaaij
' Modified: Fred Kerber
' version: 1.1
' website: http://www.howto-outlook.com/downloads/backupscript.htm
' Changes:
' Changed var types; changed to backup full folder and not just pst files.
'===================================================================
'===================BEGIN MODIFY====================================
'Define the folder location of Outlook's data files.
sOutlookDataPath = "C:\Users\FKerber.CORP\AppData\Local\Microsoft\Outlook\"
'Define your backup location
sBackupPath = "E:\Outlook Backup\"
'Keep old backups? TRUE/FALSE
bKeepHistory = TRUE
'Maximum time in milliseconds for Outlook to close on its own
iDelay = 30000 'It is not recommended to set this below 8000
'Start Outlook again afterwards? TRUE/FALSE
bStart = True
'===================STOP MODIFY====================================
'Close Outlook
Call CloseOutlook(iDelay)
'Outlook is closed, so we can start the backup
Call BackupOutlook(sOutlookDataPath, sBackupPath, bKeepHistory)
'Open Outlook again when desired.
If bStart = TRUE Then
Call OpenOutlook()
End If
Sub CloseOutlook(iDelay)
Set objWMIService = GetObject("winmgmts:" &_
{impersonationLevel= impersonate}!\\.\root\cimv2")
'If Outlook is running, let it quit on its own.
For Each oProcess in objWMIService.InstancesOf("Win32_Process")
If StrComp(oProcess.Name,"OUTLOOK.EXE",vbTextCompare) = 0 Then
Set objOutlook = CreateObject("Outlook.Application")
objOutlook.Quit
WScript.Sleep delay
Exit For
End If
Next
'Make sure Outlook is closed and otherwise force it.
Set colProcessList = objWMIService.ExecQuery _
("Select * from Win32_Process Where Name = 'Outlook.exe'")
For Each objProcess in colProcessList
objProcess.Terminate()
Next
Set objWMIService = Nothing
Set objOutlook = Nothing
Set colProcessList = Nothing
End Sub
Sub BackupOutlook(sOutlook, sBackupPath, bKeepHistory)
Set ofso = CreateObject("Scripting.FileSystemObject")
If bKeepHistory = True Then
sArchiveFolder = Year(Now) & "-" & Month(Now) & "-" & Day(Now)
sBackupPath = sBackupPath & sArchiveFolder & "\"
Else
For Each oFile In ofso.GetFolder(sBackupPath).Files
ofso.DeleteFile oFile.Path, True
Next
End If
If ofso.FolderExists(sBackupPath) = False Then
ofso.CreateFolder sBackupPath
End If
For Each oFile In ofso.GetFolder(sOutlook).Files
If ofso.FileExists(oFile.Path) Then
ofso.CopyFile oFile.Path, sBackupPath, True
End If
Next
Set ofso = Nothing
End Sub
Sub OpenOutlook()
Set objShell = CreateObject("WScript.Shell")
objShell.Run "Outlook.exe"
End Sub
I had a similar problem trying to delete files with VBS. I assume that as with my case: The source of the problem is that the script is trying to perform some operation on a file or folder that has a Read-only Attribute. To solve this manually you could left click -> properties -> unclick the Read-Only Attribute then the file/folder should be copied by the script. To solve the problem with VBS: I make the assumption that file/folder is set to Read-Only because there is a programme currently using them.
One: we can just skip files/folders set to read-only this time and hope to get them next time the script runs. For this we first check if file/folder is read-only (I got this from here: https://social.technet.microsoft.com/Forums/ie/en-US/7382d452-1ef9-404a-8874-48d38fcfe911/vbscript-verify-if-a-file-is-readonly?forum=ITCG), if not then we perform the copy operation.
Sub BackupPST(pst, BackupPath, KeepHistory)
'........
For Each pstPath in pst
If fso.FileExists(pstPath) Then
If not (fso.GetFile(pstPath).Attributes AND 1) Then 'if item is not read-only
fso.CopyFile pstPath, BackupPath, True
End If
End If
Next
Set fso = Nothing
End SubSub
Two: At the very least this should prevent you from getting the error. But if the script never moves the files even after running a number of times then chances are that the files (you are trying to move) are always in read only and you should change Attribute of the file (you are trying to move) in your script before calling the copy function, see how to do that here: https://devblogs.microsoft.com/scripting/how-can-i-change-a-read-only-file-to-a-read-write-file/