Access VB - Shell string problems - string

Trying to create the string for use with the Shell command in Access VB. The string works if written in full but if I try to use variables in the string the command does not work even if the use of variables produces exactly the full string, (in the immediate window), that works.
I suspect something is going on in the interpretation of the string version of the code but can't work out what.
Here's the code, I have used CHR(34) to produce the quotation marks that I want to show in the string. Suggestions would be so much appreciated - I don't have much hair left!
Private Sub temp()
Dim strFilePath As String
Dim strFileName As String
Dim strZipFilename As String
Dim strPDFfilename As String
Dim strShellString As String
Dim shell As Object
Dim result As Long
Set shell = CreateObject("WScript.shell")
strFilePath = "E:\Documents\Excel Spreadsheets\Roz Theremas\Access\PDFs"
strFileName = "17-03-31temp"
strZipFilename = strFilePath & "\" & strFileName & ".zip"
strZipFilename = Chr(34) & strZipFilename & Chr(34)
strPDFfilename = strFilePath & "\" & strFileName & ".pdf"
strPDFfilename = Chr(34) & strPDFfilename & Chr(34)
strShellString = Chr(34) & Chr(34) & Chr(34) & "C:\Program Files\7-Zip\7z.exe" & Chr(34) & Chr(34) & " a -tzip " & Chr(34) & strZipFilename & Chr(34) & " " & Chr(34) & strPDFfilename & Chr(34) & Chr(34)
'Non Working shell command
result = shell.Run(strShellString, 0, False)
'Working shell command
result = shell.Run("""C:\Program Files\7-Zip\7z.exe"" a -tzip ""E:\Documents\Excel Spreadsheets\Roz Theremas\Access\PDFs\17-03-31temp.zip"" ""E:\Documents\Excel Spreadsheets\Roz Theremas\Access\PDFs\17-03-31temp.pdf""", 0, False)
'Immediate Window output of strShellString
' """C:\Program Files\7-Zip\7z.exe"" a -tzip ""E:\Documents\Excel Spreadsheets\Roz Theremas\Access\PDFs\17-03-31temp.zip"" ""E:\Documents\Excel Spreadsheets\Roz Theremas\Access\PDFs\17-03-31temp.pdf"""
End Sub

My hair is saved - I worked out the answer! So, for posterity here it is.
I modified strFilePath to put quotes around the two word folder names and removed quotations from around the strZipFilename and strPDFFilename lines. I guess Shell was suffering from a surfeit of quotes.
Whilst modifying it I added a password to the zip file and changed the false to true at the end of the string command so that it would return an error code.
Thanks to anyone who spent time trying to work out what I had done.
Public Sub temp()
Dim strFilePath As String
Dim strFileName As String
Dim strZipFilename As String
Dim strPDFfilename As String
Dim strPassword As String
Dim shell As Object
Dim result As Long
Set shell = CreateObject("WScript.shell")
strPassword = "frog"
strFilePath = "E:\Documents\""Excel Spreadsheets""\""Roz Theremas""\Access\PDFs"
strFileName = "17-03-31temp"
strZipFilename = strFilePath & "\" & strFileName & ".zip"
strPDFfilename = strFilePath & "\" & strFileName & ".pdf"
result = shell.Run("""C:\Program Files\7-Zip\7z.exe"" a -tzip " & "-p" & strPassword & " " & strZipFilename & " " & strPDFfilename, 0, True)

Related

How to see who viewed my shared excel sheet

I want to have a shared excel document, I want to know how many users have viewed it, basically its viewing history. I have checked for google sheets but that feature is only available for people with company domains not for individual. If anything apart from google sheet that can track the viewing history will also do. Please suggest
In the Workbook.Open event, make a call to this Sub. The user name, machine name and what time the user opened the file will be part of the filename. You can save more information when the code opens the file (see the code comment when printing to file):
Sub fnSaveAccessLog()
Dim strLogFile As String
Dim lngFF As Long
Dim strMachine As String
Dim strUser As String
Dim strDate As String
Dim strFileName As String
On Error Resume Next
MkDir ThisWorkbook.Path & "\Logs"
On Error GoTo 0
strLogFile = "UserAccess"
strMachine = Environ("computername")
strUser = Environ("username")
strDate = Year(Now) & Format(Month(Now), "00") & Format(Day(Now()), "00") & "_" & _
Format(Hour(Now()), "00") & Format(Minute(Now()), "00") & Format(Second(Now()), "00")
strFileName = ThisWorkbook.Path & "\Logs\" & strLogFile & "_" _
& strDate & "_" & strUser & "_" & strMachine & ".txt"
lngFF = VBA.FreeFile
Open strFileName For Output As #lngFF
Print #lngFF, "put more info here if desired"
Close #lngFF
End Sub
After reading #indnwkybrd's comments I modified the code, to implement the two commented suggestions (thanks!) and simplified the construction of the filename variable.
Option Explicit
Sub fnAppendAccessLog()
Dim lngFF As Long
Dim strMachine As String
Dim strUser As String
Dim strDate As String
Dim strFileName As String
On Error Resume Next
MkDir ThisWorkbook.Path & "\Logs"
On Error GoTo 0
strMachine = Environ("computername")
strUser = Environ("username")
strDate = Format$(Now, "yyyyMMDD_hhmmss")
strFileName = ThisWorkbook.Path & "\Logs\" & "UsersAccessLog - " & Split(ThisWorkbook.Name, ".")(0) & ".txt"
lngFF = VBA.FreeFile
Open strFileName For Append As #lngFF
Print #lngFF, Join$(Array(strUser, strMachine, strDate), vbTab)
Close #lngFF
End Sub

Getting Run-time error '-2147024894 (80070002)' when my code file is palced in a folder with space in it's name

When I am placing the code Excel file in a folder/directory which does not have any space in it the naming conventions than it is working fine and firing the Web-Service. But when I place the code Excel file in a folder which has space in it's naming convention, I am getting a run-time error:
'-2147024894 (80070002).
Please help
Sub InvokShellScript1()
Dim sApp As String
Dim var As Integer
sApp = ThisWorkbook.Path & "\protected\WSInvoke.bat " & ThisWorkbook.Path & "\protected\Refresh.txt " & ThisWorkbook.Path
Dim objShell As Object
Set objShell = CreateObject("WScript.Shell")
var = objShell.Run(sApp, 0, True)
End Sub
You need quotes around the paths to be able to handle spaces. Try either of these:
sApp = Chr$(34) & ThisWorkbook.Path & "\protected\WSInvoke.bat" & Chr$(34) & " " & Chr$(34) & ThisWorkbook.Path & "\protected\Refresh.txt" & Chr$(34) & " " & Chr$(34) & ThisWorkbook.Path & Chr$(34)
or if Chr() doesn't work:
sApp = """" & ThisWorkbook.Path & "\protected\WSInvoke.bat"" """ & ThisWorkbook.Path & "\protected\Refresh.txt"" """ & ThisWorkbook.Path & """"

Save to %temp% folder

I need to save embedded Word document from Excel to Windows %temp% folder. My current solution is not working. Where is the mistake?
Dim tempFolderPath As String
Dim filePath As String
Dim fileTitle As String
tempFolderPath = Environ("Temp")
fileTitle = ThisWorkbook.Sheets("Other Data").Range("AK2").Value & ", " & _
ThisWorkbook.Sheets("Other Data").Range("AK7").Value & "_" & _
ThisWorkbook.Sheets("Other Data").Range("AK8").Value & "_" & _
ThisWorkbook.Sheets("Other Data").Range("AU2").Value
objWord.SaveAs2 filePath = tempFolderPath & "\" & fileTitle & ".docx"
SaveAs2 method doesn't have a property called filePath. I think you're looking for FileName.
Try this:
objWord.SaveAs2 FileName:= tempFolderPath & "\" & fileTitle & ".docx"
Hope this helps!

Capture Output of WScript Shell Object

This code upload a file to a FTP Server using Putty
Dim wsh As Object
Dim waitOnReturn As Boolean
Dim windowStyle As Integer
Dim cstrSftp As String
Dim strCommand As String
Dim pUser As String
Dim pPass As String
Dim pHost As String
Dim pFile As String
Dim pRemotePath As String
Dim site As String
Dim resp As String
Set wsh = VBA.CreateObject("WScript.Shell")
'Wait the execution to finish
waitOnReturn = True
'Show the window
windowStyle = 1
'Variables
cstrSftp = """" & Application.ActiveWorkbook.Path & "\pscp.exe" & """"
site = "http://mysite/"
pUser = "user"
pPass = "password "
pHost = "ftp.mysite"
pRemotePath = "/home/"
pFile = """" & Application.ActiveWorkbook.Path & "file.png" & """"
'Command string
strCommand = "cmd /c echo n | " & cstrSftp & " -sftp -l " & pUser & " -pw " & pPass & " " & pFile & " " & pHost & ":" & pRemotePath
'Run the command
wsh.Run strCommand, windowStyle, waitOnReturn
Since the storage server is not reliable I need to capture the output to know if the upload worked. And, if it doesn't I need to know what was the message.
I thought of using the command " > C:\output.txt" to capture the output. Like this
strCommand = strCommand & " > " & """" "C:\output.txt" & """"
When the upload works my output file works too. But, when the upload doesn't work, nothing is written in the output file.
For example, when I get the message Fatal: Server unexpectedly closed network connection nothing is written in the output file. But I need to know what is the exactly messaged given.
Example for using exec to retrieve output, maybe this is useful in your case
Sub TestExec()
Dim wsh As New WshShell
Dim s As String
s = wsh.Exec("cmd /c Dir C:\ ").StdOut.ReadAll
Debug.Print s
End Sub

Repeated 1 mail while sending mail via Thunderbird from Excel

I have created VBA code for sending mails with different attachments to different addresses, via Thunderbird. The code looks correct but while creating particular mail bodies it uses still the first values. And the strange fact is that in the debugging window all looks correct and the values are changing.
$
Option Explicit
Sub SendMailThunder_Click()
Dim strEmpfaenger1 As String
Dim strBetr As String
Dim strBody As String
Dim strFile2 As Variant
Dim strTh As String
Dim strCommand As Variant
Dim Nazev As String
Dim vysledek As Variant
Dim Seznam As Excel.Worksheet
Dim PS As Integer
Dim y As Long
Set Seznam = ThisWorkbook.Worksheets("Ridici")
' number of items in the column
PS = Seznam.Cells(Rows.Count, 11).End(xlUp).Row
With Seznam
For y = 4 To PS
' Name of attachment
Nazev = .Cells(y, 12).Value
' selected email
strEmpfaenger1 = .Cells(y, 15).Value
strBetr = .Range("O1")
strBody = .Range("O2")
strTh = "C:\Users\alois.konecny\AppData\Local\Mozilla Thunderbird\thunderbird.exe"
' path to attachment
cesta = .Range("N1")
' attachment including path
priloha = "\" & Nazev & ".xls"
vysledek = cesta & priloha
strFile2 = vysledek
strCommand = strCommand & " -compose " & "to=" & Chr(34) & strEmpfaenger1 & Chr(34)
strCommand = strCommand & ",subject=" & Chr(34) & strBetr & Chr(34)
strCommand = strCommand & ",body=" & Chr(34) & strBody & Chr(34)
strCommand = strCommand & ",attachment=" & "file:///" & Replace(strFile2, "\", "/")
Shell strTh & strCommand, vbNormalFocus
Next y
End With
End Sub
$
The code is a bit hard to read, but have your tried this:
file://
instead of
file:///

Resources