i'm working on a form where user can upload, im using FreeASPUpload component.
Right now i can upload anything and that would cause major security issue on server. How can i restrict only specific file types. i only want users to upload ".doc", ".docx" and ".pdf" files.
Here is the source code.
<%# Language=VBScript %>
<%
option explicit
Response.Expires = -1
Server.ScriptTimeout = 600
Session.CodePage = 65001
%>
<!-- #include file="UploadClass.asp" -->
<!-- #include file="ADOVBS.inc" -->
<%
Dim uploadsDirVar
uploadsDirVar = server.MapPath("Resumes_Uploaded")
function OutputForm()
%>
<form name="frmSend" id="appform" method="POST" enctype="multipart/form-data" accept-charset="utf-8" action="form.asp" onSubmit="return onSubmitForm();">
<input type="hidden" name="ApplicationForm" value="Insert" />
Name: <input type="text" name="name_insert" value="" size="30" />
<B>File names:</B><br>
File 1: <input name="attach1" type="file" size=35><br>
<br>
<input style="margin-top:4" type="submit" value="Submit">
</form>
<%
end function
function TestEnvironment()
Dim fso, fileName, testFile, streamTest
TestEnvironment = ""
Set fso = Server.CreateObject("Scripting.FileSystemObject")
if not fso.FolderExists(uploadsDirVar) then
TestEnvironment = "<B>Folder " & uploadsDirVar & " does not exist.</B><br>The value of your uploadsDirVar is incorrect. Open uploadTester.asp in an editor and change the value of uploadsDirVar to the pathname of a directory with write permissions."
exit function
end if
fileName = uploadsDirVar & "\test.txt"
on error resume next
Set testFile = fso.CreateTextFile(fileName, true)
If Err.Number<>0 then
TestEnvironment = "<B>Folder " & uploadsDirVar & " does not have write permissions.</B><br>The value of your uploadsDirVar is incorrect. Open uploadTester.asp in an editor and change the value of uploadsDirVar to the pathname of a directory with write permissions."
exit function
end if
Err.Clear
testFile.Close
fso.DeleteFile(fileName)
If Err.Number<>0 then
TestEnvironment = "<B>Folder " & uploadsDirVar & " does not have delete permissions</B>, although it does have write permissions.<br>Change the permissions for IUSR_<I>computername</I> on this folder."
exit function
end if
Err.Clear
Set streamTest = Server.CreateObject("ADODB.Stream")
If Err.Number<>0 then
TestEnvironment = "<B>The ADODB object <I>Stream</I> is not available in your server.</B><br>Check the Requirements page for information about upgrading your ADODB libraries."
exit function
end if
Set streamTest = Nothing
end function
function SaveFiles
Dim Upload, fileName, fileSize, ks, i, fileKey, strFileName, strFileType, oFSO, DelFile, fso
Set Upload = New FreeASPUpload
Upload.Save(uploadsDirVar)
' If something fails inside the script, but the exception is handled
If Err.Number<>0 then Exit function
SaveFiles = ""
ks = Upload.UploadedFiles.keys
if (UBound(ks) <> -1) then
SaveFiles = "<B>Files uploaded:</B> "
for each fileKey in Upload.UploadedFiles.keys
SaveFiles = SaveFiles & Upload.UploadedFiles(fileKey).FileName & " (" & Upload.UploadedFiles(fileKey).Length & "B) "
next
else
SaveFiles = "No file selected for upload or the file name specified in the upload form does not correspond to a valid file in the system."
end if
%>
<%
'=======================================================================================
' CONNECT DATABASE
'=======================================================================================
Dim objConn, objRs, InsCom, InsName
Set objConn = CreateObject("ADODB.Connection")
Set objRs = CreateObject("ADODB.Recordset")
objConn.open"Provider=Microsoft.Jet.OLEDB.4.0;Data Source="& server.MapPath("db/Job_database.mdb") &";Mode=ReadWrite|Share Deny None;Persist Security Info=False"
If Upload.Form("ApplicationForm") = "Insert" Then
Set InsCom=Server.CreateObject("ADODB.Command")
InsCom.ActiveConnection=objConn
InsName = Trim(Upload.Form("name_insert"))
InsName = replace(InsName,"'","''")
InsCom.CommandText = "Insert into applications(aname)Values(?)"
InsCom.Parameters.Append InsCom.CreateParameter("#name_insert", adVarChar, adParamInput, 255, InsName)
InsCom.Execute
End If
Response.Redirect("success.asp")
end function
%>
<HTML>
<HEAD>
<TITLE>Test Free ASP Upload 2.0</TITLE>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
<style>
BODY {background-color: white;font-family:arial; font-size:12}
</style>
<script>
function onSubmitForm() {
var formDOMObj = document.frmSend;
if (formDOMObj.attach1.value == "")
alert("Please press the Browse button and pick a file.")
else
return true;
return false;
}
</script>
</HEAD>
<BODY>
<br><br>
<div style="border-bottom: #A91905 2px solid;font-size:16">Upload files to your server</div>
<%
Dim diagnostics
if Request.ServerVariables("REQUEST_METHOD") <> "POST" then
diagnostics = TestEnvironment()
if diagnostics<>"" then
response.write "<div style=""margin-left:20; margin-top:30; margin-right:30; margin-bottom:30;"">"
response.write diagnostics
response.write "<p>After you correct this problem, reload the page."
response.write "</div>"
else
response.write "<div style=""margin-left:150"">"
OutputForm()
response.write "</div>"
end if
else
response.write "<div style=""margin-left:150"">"
OutputForm()
response.write SaveFiles()
response.write "<br><br></div>"
end if
%>
</BODY>
</HTML>
I have searched alot and found only a few solutions, but they doesn't work on my end.
here is the most recent changes i made, but the file doesn't gets deleted from the server after file uploaded.
Here is the code
function SaveFiles
Dim Upload, fileName, fileSize, ks, i, fileKey, strFileType, oFSO
Set Upload = New FreeASPUpload
Upload.Save(uploadsDirVar)
' If something fails inside the script, but the exception is handled
If Err.Number<>0 then Exit function
SaveFiles = ""
ks = Upload.UploadedFiles.keys
if (UBound(ks) <> -1) then
SaveFiles = "<B>Files uploaded:</B> "
for each fileKey in Upload.UploadedFiles.keys
strFileType = Left(Upload.UploadedFiles(fileKey).ContentType,5)
if strFileType = ".doc" and ".docx" and ".pdf" Then
SaveFiles = SaveFiles & Upload.UploadedFiles(fileKey).FileName & " (" & Upload.UploadedFiles(fileKey).Length & "B) "
else
DelFile = DelFiles & Upload.UploadedFiles(fileKey).FileName & ","
end if
next
%>
<%
else
SaveFiles = "The file name specified in the upload form does not correspond to a valid file in the system."
end if
if DelFile <> "" Then
DelFile = left(DelFile,len(DelFile)-1)
set oFSO = CreateObject("Scripting.FileSystemObject")
if inStr(DelFile,",") > 0 then
arrDelete = split(DelFile,",")
for i = 0 to UBound(arrDelete)
oFSO.DeleteFile uploadsDirVar & arrDelete(i)
next
else
oFSO.DeleteFile uploadsDirVar & DelFile
end if
oFSO.close
set oFSO = nothing
end if
FreeASPUpload documentation doesn't help.
I tested this code, and it works as expected...
function SaveFiles
' You forgot to declare the DelFile Variable
Dim Upload, fileName, fileSize, ks, i, fileKey, strFileType, oFSO, DelFile
Set Upload = New FreeASPUpload
Upload.Save(uploadsDirVar)
' If something fails inside the script, but the exception is handled
If Err.Number<>0 then Exit function
' Set DelFile Variable to empty string
DelFile = ""
SaveFiles = ""
ks = Upload.UploadedFiles.keys
if (UBound(ks) <> -1) then
SaveFiles = "<B>Files uploaded:</B> "
for each fileKey in Upload.UploadedFiles.keys
' This does not return the file extension of the file uploaded
' strFileType = Left(Upload.UploadedFiles(fileKey).ContentType,5)
strFileType = Mid(Upload.UploadedFiles(fileKey).FileName, InstrRev(Upload.UploadedFiles(fileKey).FileName, ".") + 1)
' This is an invalid if statement
' if strFileType = ".doc" and ".docx" and ".pdf" Then
if strFileType = "doc" or strFileType = "docx" or strFileType = "pdf" Then
SaveFiles = SaveFiles & Upload.UploadedFiles(fileKey).FileName & " (" & Upload.UploadedFiles(fileKey).Length & "B) "
else
' The var DelFiles does not exist
'DelFile = DelFiles & Upload.UploadedFiles(fileKey).FileName & ","
DelFile = DelFile & Upload.UploadedFiles(fileKey).FileName & ","
end if
next
else
SaveFiles = "The file name specified in the upload form does not correspond to a valid file in the system."
end if
if DelFile <> "" Then
DelFile = left(DelFile,len(DelFile)-1)
set oFSO = CreateObject("Scripting.FileSystemObject")
if inStr(DelFile,",") > 0 then
arrDelete = split(DelFile,",")
for i = 0 to UBound(arrDelete)
' this is wrong, you're missing a backspace
' oFSO.DeleteFile uploadsDirVar & arrDelete(i)
oFSO.DeleteFile uploadsDirVar & "\" & arrDelete(i)
next
else
' this is wrong, you're missing a backspace
' oFSO.DeleteFile uploadsDirVar & DelFile
oFSO.DeleteFile(uploadsDirVar & "\" & DelFile)
end if
' This is an invalid statement
' oFSO.close
set oFSO = nothing
end if
end function
Note: Your code was full of errors... I tried my best to explain where they were and what they were, but that's no substitute for learning how to properly debug asp code. You should try to get a grasp on how to debug asp, before attempting to integrate my code in your solution.
Related
When I incorporate a filter into my VBA sub, it does not filter out all the gif files from being excluded.
The sub is to remove attachments from emails and replace them with a link.
I expect to skip all instances of the gif attachments. The reasoning is for email threads where users have gif pictures in their signature, and removing the gif files will ruin the cleanness of the thread, and make it difficult for users to see who wrote which part of the email.
Here is the entire sub.
Private Sub BrowseFolder()
Dim oShell As Object
Set oShell = CreateObject("Shell.Application")
Dim fsSaveFolder As Object
Set fsSaveFolder = oShell.BrowseForFolder(0, "Please Select a Save Folder:", 1)
'Set fsSaveFolder = oShell.BrowseForFolder(0, "Please Select a Save Folder:", NO_OPTIONS, "C:\users\" & Environ("Username") & "Documents\Outlook Files")
If fsSaveFolder Is Nothing Then Exit Sub
' Note: BrowseForFolder doesn't add a trailing slash
' Ask the user to select an Outlook folder to process
Dim olPurgeFolder As Outlook.MAPIFolder
Set olPurgeFolder = Outlook.GetNamespace("MAPI").PickFolder
If olPurgeFolder Is Nothing Then Exit Sub
Dim msg As Variant
Dim att As Outlook.Attachments
Dim sSavePathFS As String
Dim sDelAtts
For Each msg In olPurgeFolder.Items
On Error GoTo GetAttachments_err
sDelAtts = ""
If TypeName(msg) = "MailItem" Then
If msg.MessageClass <> "IPM.Note.SMIME.MultipartSigned" Then
If msg.MessageClass <> "IPM.Note.Secure.Sign" Then
'If msg.Attachments.Count > 0 Then '& olByValue <> 5 & olByValue <> 6 Then
Set att = msg.Attachments
lngCount = att.Count
DelAtts = ""
If lngCount > 0 Then
' We need to use a count down loop for removing items
' from a collection. Otherwise, the loop counter gets
' confused and only every other item is removed.
For i = lngCount To 1 Step -1
' Save attachment before deleting from item.
' Get the file name.
strFile = att.Item(i).FileName
' This code looks at the last 4 characters in a filename
sFileType = LCase$(Right$(strFile, 4))
If att.Item(i).Size < 5234111 Then
Select Case sFileType
' Add additional file types below
Case ".gif", "gif"
Case Else
'While msg.Attachments.Count > 0
On Error GoTo GetAttachments_err
' Save the attachment to the file system
sSavePathFS = fsSaveFolder.Self.Path & "\"
attachName = msg.Attachments(1).FileName
msg.Attachments(1).SaveAsFile sSavePathFS & Format(msg.ReceivedTime, "mm-dd-yyyy-ss") & attachName
' Build up a string to denote the file system save path(s)
' Format the string according to the msg.BodyFormat.
If msg.BodyFormat <> olFormatHTML Then
sDelAtts = sDelAtts & vbCrLf & "<file://" & sSavePathFS & Format(msg.ReceivedTime, "mm-dd-yyyy-ss") & attachName & ">"
Else
sDelAtts = sDelAtts & "<br>" & "<a href='file://" & sSavePathFS & Format(msg.ReceivedTime, "mm-dd-yyyy-ss") & attachName & "'>" & sSavePathFS & Format(msg.ReceivedTime, "mm-dd-yyyy-ss") & attachName & "</a>"
End If
' Delete the current attachment. We use a "1" here instead of an "i"
' because the .Delete method will shrink the size of the msg.Attachments
' collection for us. Use some well placed Debug.Print statements to see
' the behavior. ~~
msg.Attachments(1).Delete
' Wend
End Select
End If
Next
' Modify the body of the msg to show the file system location of
' the deleted attachments.
If msg.BodyFormat <> olFormatHTML Then
msg.Body = vbCrLf & vbCrLf & "Attachments Deleted: " & Date & " " & Time & vbCrLf & vbCrLf & "Saved To: " & vbCrLf & sDelAtts & msg.Body
Else
msg.HTMLBody = "<p></p><p>" & "Attachments Deleted: " & Date & " " & Time & vbCrLf & vbCrLf & "Saved To: " & vbCrLf & sDelAtts & "</p>" & msg.HTMLBody
End If
' Save the edits to the msg. If you forget this line, the attachments will not be deleted. ~~
msg.Save
End If
End If
End If
End If
Next
GetAttachments_exit:
Set att = Nothing
Set fso = Nothing
Set olPurgeFolder = Nothing
Exit Sub
' Handle errors
GetAttachments_err:
If Err.Description = "Outlook cannot perform this action on this type of attachment." Then
Err.Clear
Resume Next
End If
MsgBox "An unexpected error has occurred." _
& vbCrLf & "Please note and report the following information." _
& vbCrLf & "Macro Name: GetAttachments" _
& vbCrLf & "Error Number: " & Err.Number _
, vbCritical, "Error!"
Resume GetAttachments_exit
End Sub
Your code had some syntax errors. Those have been corrected in the code below.
If lngCount > 0 Then
For i = lngCount To 1 Step -1
' Save attachment before deleting from item.
' Get the file name.
strFile = att.Item(i).Filename
' This code looks at the last 4 characters in a filename
sFileType = LCase$(Right$(strFile, 4))
If att.Item(i).Size < 5234111 Then
Select Case sFileType
Case ".gif", "gif"
End Select
End If
Next
End If
If your intention is to delete the gif attachments then you might want to try att.Item(i).Delete on the line after Case ".gif", "gif"
The problem of this script is that it shows an unknown error Message while running the script.
I called the function by echo method in my ftp which is "filezilla".
every thing is working fine as it logs into the server check for the path, open channel for data writing. Still dont know where is the problem
Function FTPUpload(sSite, sUsername, sPassword, sLocalFile, sRemotePath)
'This script is provided under the Creative Commons license located
'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
'be used for commercial purposes with out the expressed written consent
'of NateRice.com
Const OpenAsDefault = -2
Const FailIfNotExist = 0
Const ForReading = 1
Const ForWriting = 2
Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
Set oFTPScriptShell = CreateObject("WScript.Shell")
sRemotePath = Trim(sRemotePath)
sLocalFile = Trim(sLocalFile)
'----------Path Checks---------
'Here we willcheck the path, if it contains
'spaces then we need to add quotes to ensure
'it parses correctly.
If InStr(sRemotePath, " ") > 0 Then
If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
sRemotePath = """" & sRemotePath & """"
End If
End If
If InStr(sLocalFile, " ") > 0 Then
If Left(sLocalFile, 1) <> """" And Right(sLocalFile, 1) <> """" Then
sLocalFile = """" & sLocalFile & """"
End If
End If
'Check to ensure that a remote path was
'passed. If it's blank then pass a "\"
If Len(sRemotePath) = 0 Then
'Please note that no premptive checking of the
'remote path is done. If it does not exist for some
'reason. Unexpected results may occur.
sRemotePath = "\"
End If
'Check the local path and file to ensure
'that either the a file that exists was
'passed or a wildcard was passed.
If InStr(sLocalFile, "*") Then
If InStr(sLocalFile, " ") Then
FTPUpload = "Error: Wildcard uploads do not work if the path contains a " & _
"space." & vbCRLF
FTPUpload = FTPUpload & "This is a limitation of the Microsoft FTP client."
Exit Function
End If
ElseIf Len(sLocalFile) = 0 Or Not oFTPScriptFSO.FileExists(sLocalFile) Then
'nothing to upload
FTPUpload = "Error: File Not Found."
Exit Function
End If
'--------END Path Checks---------
'build input file for ftp command
sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
sFTPScript = sFTPScript & sPassword & vbCRLF
sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
sFTPScript = sFTPScript & "binary" & vbCRLF
sFTPScript = sFTPScript & "prompt n" & vbCRLF
sFTPScript = sFTPScript & "put " & sLocalFile & vbCRLF
sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF
sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
'Write the input file for the ftp command
'to a temporary file.
Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
fFTPScript.WriteLine(sFTPScript)
fFTPScript.Close
Set fFTPScript = Nothing
oFTPScriptShell.Run "%comspec% /c FTP -n -s:" & sFTPTempFile & " " & sSite & _
" > " & sFTPResults, 0, TRUE
Wscript.Sleep 1000
'Check results of transfer.
Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
FailIfNotExist, OpenAsDefault)
sResults = fFTPResults.ReadAll
fFTPResults.Close
oFTPScriptFSO.DeleteFile(sFTPTempFile)
oFTPScriptFSO.DeleteFile (sFTPResults)
If InStr(sResults, "226 Transfer complete.") > 0 Then
FTPUpload = True
ElseIf InStr(sResults, "File not found") > 0 Then
FTPUpload = "Error: File Not Found"
ElseIf InStr(sResults, "cannot log in.") > 0 Then
FTPUpload = "Error: Login Failed."
Else
FTPUpload = "Error: Unknown."
End If
Set oFTPScriptFSO = Nothing
Set oFTPScriptShell = Nothing
WScript.Echo "Process Completed (" & Now & ")"
End Function
I can't seem to find any information on SQL scripts for Syspro - Google searches just come up with 3rd party software despite Syspro using a fairly standard looking SQL database.
I'm just wondering if anyone on here has any experience with updating Syspro via SQL updates - I have a client that uses Syspro and they've previously updated it by exporting everything into Access, making changes and updating everything from there - I was told by their out-going IT consultant that this is the only way to update Syspro (which, I suspect, isn't true).
Just looking for some do's and dont's before I go screwing up data!
thanks,
Darren
It's not advisable to update the SYSPRO database directly. While it is relatively simple to breakdown and track what data is stored where etc. there is more often than not more than 1 place where a field is updated and/or there is an additional flag that is also changed. Further, updating it directly in the database would also get rid of any possible audit trail.
If this needs to be done in bulk (as your question seems to refer) then this would be best done by posting an update using one of the SYSPRO "business objects". Have a look here for more info regarding business objects: SYSPRO Business Object Library
There are 2 ways you can make use of this: in a custom pane within SYSPRO (no licensing requirements then) or if your customer is licensed for the respective business object you could write an external program to post updates using the business object.
Below is a custom pane I created sometime ago that updates prices of items based on an excel spreadsheet. Save the below code section into a txt file and when in SYSPRO if you click on the drop down arrow (on the top right of any pane) you can select Customized Pane > Import Customized Pane and specify this txt file you have saved. This will create the custom pane with title Pricelist Import. If you now press the refresh button on this customized pane it's going to ask you for an excel file to base it's update on. By default it will look for a file called Pricelist Import.xlsx in the SYSPRO\Base\Settings folder of the machine you are working on. You will need to create a spreadsheet with 5 columns and in this order too (StockCode, PriceCode, SellingPrice, PriceBasis, CommisionCode). Once you have a spreadsheet and specify the file at this prompt it will load the contents of the spreadsheet into the listview and by default all entries will be selected to import. If you now press Update it will update the prices accordingly and if not possible will return the respective error messages back into the listview.
# Customized Panes for 'IMPDH2LZ' Created: 2013/09/17
# PANE:Pricelist Import
[PANE]
CHRISVIMPDH2LZ 01000Pricelist Import 020 000000500001IMPDH2000M000Update 3362 00000 0
[VBSCRIPT]
' This script contains functions for customized pane events.
' You must not modify the name of the functions.
Option Explicit
Public Debug : Debug = "False"
Function CustomizedPane_OnRefresh()
Dim ImportFilePmt : ImportFilePmt = InputBox("Enter Location of Excel file to Import?", "Pricelist Import File", SystemVariables.CodeObject.baseSettingsFolder &"Pricelist Import.xlsx")
Dim objExcel : Set objExcel = CreateObject("Excel.Application")
On error resume next
Dim objWorkbook : Set objWorkbook = objExcel.Workbooks.Open(ImportFilePmt)
If err then
If ImportFilePmt <> "" then
msgbox "Error Importing File: " & vbcrlf & err.Description & vbCrlf & vbCrlf & "Import Cancelled!!", vbCritical, "Error Importing/Opening File"
Exit Function
Else
CustomizedPane_OnLoad
Exit Function
End If
End if
on error Goto 0
Dim objWorksheet : Set objWorksheet = objExcel.Worksheets(1)
objWorksheet.Activate
Dim intRow : intRow = 2
Dim XMLForList
Dim intLinesRow : intLinesRow = 2
XMLForList = "<ImportList>"
Do Until objExcel.Cells(intLinesRow,1).Value = "" or objExcel.Cells(intLinesRow,1).Value = " "
XMLForList = XMLForList & "<Item><StockCode>"& objExcel.Cells(intLinesRow, 1).Value &"</StockCode>"
XMLForList = XMLForList & "<PriceCode>" & objExcel.Cells(intLinesRow,2).Value & "</PriceCode>"
XMLForList = XMLForList & "<SellingPrice>" & objExcel.Cells(intLinesRow,3).Value & "</SellingPrice>"
XMLForList = XMLForList & "<PriceBasis>" & objExcel.Cells(intLinesRow,4).Value & "</PriceBasis>"
XMLForList = XMLForList & "<CommisionCode>" & objExcel.Cells(intLinesRow,5).Value & "</CommisionCode>"
XMLForList = XMLForList & "<Import>1</Import>"
XMLForList = XMLForList & "</Item>"
intLinesRow = intLinesRow + 1
Loop
XMLForList = XMLForList & "</ImportList>"
objExcel.Quit
Dim ListXML
ListXML = ListXML & "<Columns PrimaryNode='Item' Style='DataGrid' AutoSize='true' FreezeColumn='0' >"
ListXML = ListXML & "<Column Name='StockCode' Description='Stock code' />"
ListXML = ListXML & "<Column Name='PriceCode' Description='Price code' />"
ListXML = ListXML & "<Column Name='SellingPrice' Description='Selling price' Type='Numeric' Alignment='Right' HdrAlignment='Right' Decimals='2' />"
ListXML = ListXML & "<Column Name='PriceBasis' Description='Price basis' />"
ListXML = ListXML & "<Column Name='CommisionCode' Description='Commision code' />"
ListXML = ListXML & "<Column Name='Import' Description='Import' Type='checkbox' Editable='true' />"
ListXML = ListXML & "</Columns>"
CustomizedPane.CodeObject.ListviewProperties = ListXML
CustomizedPane.CodeObject.ListviewData = XMLForList
msgbox intLinesRow - 2 & " record/s read",vbInformation,"File Imported"
End Function
Function FileHandle(Action, ActVariable)
Dim Path : Path = SystemVariables.CodeObject.baseSettingsFolder & "ExcelImportPanePath.txt"
Const ForReading = 1
Const ForWriting = 2
Const ForAppending = 8
dim fso, ts
Set fso = CreateObject("Scripting.FileSystemObject")
If Action = "WritePath" then
Set ts = fso.CreateTextFile(Path,2,False)
ts.Write (ActVariable)
ts.Close
Elseif Action = "DeletePath" then
Set ts = fso.OpenTextFile(Path,1)
Dim FilePathDP : FilePathDP = ts.ReadAll
ts.Close
fso.DeleteFile FilePathDP
Elseif Action = "ReadPath" then
on error Resume Next
Set ts = fso.OpenTextFile(Path,ForReading)
Dim strLine
Do Until ts.AtEndOfStream
strLine = ts.ReadLine
Loop
ts.close
if Err then
FileHandle = "File Deleted"
Else
FileHandle = strLine
End if
On Error Goto 0
Elseif Action = "Delete" then
On Error Resume Next
fso.DeleteFile Path
If err then
Exit Function
End if
On Error Goto 0
End if
End Function
Function CustomizedPane_OnLoad()
Dim ListXML
ListXML = ListXML & "<Columns PrimaryNode='Notify' Style='DataGrid' AutoSize='true' FreezeColumn='0' >"
ListXML = ListXML & "<Column Name='Note' Description='NOTE' />"
ListXML = ListXML & "</Columns>"
CustomizedPane.CodeObject.ListviewProperties = ListXML
Dim ShowNote
ShowNote = "<Start>"
ShowNote = ShowNote & "<Notify><Note>First Load the Excel File Path...</Note></Notify>"
ShowNote = ShowNote & "</Start>"
CustomizedPane.CodeObject.ListviewData = ShowNote
End Function
Function CustomizedPane_OnToolbarButton1Clicked()
Dim MaxRows : MaxRows = Ubound(CustomizedPane.CodeObject.Array, 2)
If MaxRows = 0 OR CustomizedPane.CodeObject.Array(0,0) = "First Load the Excel File Path..." then
Exit Function
Else
Dim Counter
Dim CLineCounter : CLineCounter = 0
For Counter = 0 to MaxRows - 1
If CustomizedPane.CodeObject.Array(5, Counter) = "1" then
CLineCounter = CLineCounter + 1
End If
Next
If CLineCounter = 0 then
msgbox "There was nothing selected to import.",vbInformation,"Importing..."
Exit Function
Else
msgbox CLineCounter & " record/s to be updated.",vbInformation,"Importing..."
CallINVSPR
End If
End If
End Function
Function CallINVSPR()
dim XMLOut, XMLParam, XMLDoc
XMLParam = "<SetupInvPrice>"
XMLParam = XMLParam & " <Parameters>"
XMLParam = XMLParam & " <IgnoreWarnings>N</IgnoreWarnings>"
XMLParam = XMLParam & " <ApplyIfEntireDocumentValid>Y</ApplyIfEntireDocumentValid>"
XMLParam = XMLParam & " <ValidateOnly>N</ValidateOnly>"
XMLParam = XMLParam & " </Parameters>"
XMLParam = XMLParam & "</SetupInvPrice>"
XMLDoc = " <SetupInvPrice>"
Dim MaxRows : MaxRows = Ubound(CustomizedPane.CodeObject.Array, 2)
Dim Counter
Dim LineCounter : LineCounter = 0
Dim CLineCounter : CLineCounter = 0
For Counter = 0 to MaxRows - 1
If CustomizedPane.CodeObject.Array(5, Counter) = "1" then
XMLDoc = XMLDoc & " <Item>"
XMLDoc = XMLDoc & " <Key>"
XMLDoc = XMLDoc & " <StockCode>" & CustomizedPane.CodeObject.Array(0, Counter) & "</StockCode>"
XMLDoc = XMLDoc & " <PriceCode>" & CustomizedPane.CodeObject.Array(1, Counter) & "</PriceCode>"
XMLDoc = XMLDoc & " </Key>"
XMLDoc = XMLDoc & " <SellingPrice>" & CustomizedPane.CodeObject.Array(2, Counter) & "</SellingPrice>"
XMLDoc = XMLDoc & " <PriceBasis>" & CustomizedPane.CodeObject.Array(3, Counter) & "</PriceBasis>"
XMLDoc = XMLDoc & " <CommissionCode>" & CustomizedPane.CodeObject.Array(4, Counter) & "</CommissionCode>"
XMLDoc = XMLDoc & " </Item>"
CLineCounter = CLineCounter + 1
End If
Next
XMLDoc = XMLDoc & " </SetupInvPrice>"
on error resume next
XMLOut = CallSetup("INVSPR",XMLParam,XMLDoc,"Update","auto")
if err then
msgbox err.Description, vBCritical, "Calling Business Object"
exit function
end if
' Switch on error handling
on error goto 0
'msgbox CLineCounter & " rows updated"
If Debug = "True" then
Dim Path : Path = SystemVariables.CodeObject.baseSettingsFolder & "DEBUGExcelImportPane.txt"
'Output XML to file
dim fso, ts
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.CreateTextFile(Path,2,True)
ts.Write ("XMLIn:" & vbCrlf & XMLDoc & vbCrlf &"XMLParam:" & vbCrlf & XMLParam & vbCrlf &"XMLOut:" & vbCrlf & XMLOut)
ts.Close
msgbox "Debug Done." & vbCrLf & " Check: "& Path
End If
ResultValidate XMLOut, "Update", CLineCounter
End Function
Function ResultValidate(XMLIn, Action, CLineCounter)
Dim XMLDOM : Set XMLDOM = CreateObject("Microsoft.XMLDOM")
XMLDOM.Async = False
XMLDOM.LoadXML(XMLIn)
Dim ListXML
Dim WarningMsgs : Set WarningMsgs = XMLDOM.GetElementsByTagName("ErrorDescription")
Dim StkList
If WarningMsgs.Length > 0 then
StkList = "<List>"
StkList = StkList & "<StockList>"
StkList = StkList & "<Notes>Errors Found: " & WarningMsgs.Length & "</Notes>"
StkList = StkList & "</StockList>"
If WarningMsgs.Length > 0 then
Dim WarnItems
For Each WarnItems in WarningMsgs
StkList = StkList & "<StockList>"
StkList = StkList & "<Notes>Error in : " & WarnItems.ParentNode.NodeName & " - " & WarnItems.PreviousSibling.PreviousSibling.Text & ": " & WarnItems.Text &"</Notes>"
StkList = StkList & "</StockList>"
Next
End If
StkList = StkList & "</List>"
ListXML = "<Columns PrimaryNode='StockList' Style='DataGrid' AutoSize='true' FreezeColumn='0' >"
ListXML = ListXML & "<Column Name='Notes' Description='Notes' Link='false' />"
ListXML = ListXML & "</Columns>"
else
StkList = "<List>"
StkList = StkList & "<StockList>"
StkList = StkList & "<Notes>No Errors Found..." & CLineCounter & " record/s updated</Notes>"
StkList = StkList & "</StockList>"
StkList = StkList & "</List>"
ListXML = "<Columns PrimaryNode='StockList' Style='DataGrid' AutoSize='true' FreezeColumn='0' >"
ListXML = ListXML & "<Column Name='Notes' Description='Notes' Link='false' />"
ListXML = ListXML & "</Columns>"
End If
CustomizedPane.CodeObject.ListviewProperties = ListXML
CustomizedPane.CodeObject.ListviewData = StkList
End Function
Perhaps if they have a test company try it out in there first so you can see what it's doing?
NB: This was done for SYSPRO 6.1 and 7. Minor updates may be required to make this work in other versions.
You can also check out the SYSPRO Forums for help relating to syspro.
Hope this helps.
In reference to the below code, what I am looking to do is rather than process an entire folder I would like only to process the emails that I selected.
Otherwise it works perfectly.
Jeff
Requires the following references:
Visual Basic for Applications
Microsoft Outlook 14.0 Object Library
OLE Automation
Microsoft Office 14.0 Object Library
Microsoft Shell Controls and Automation
Public Sub SaveOLFolderAttachments()
' Ask the user to select a file system folder for saving the attachments
Dim oShell As Object
Set oShell = CreateObject("Shell.Application")
Dim fsSaveFolder As Object
Set fsSaveFolder = oShell.BrowseForFolder(0, "Please Select a Save Folder:", 1)
If fsSaveFolder Is Nothing Then Exit Sub
' Note: BrowseForFolder doesn't add a trailing slash
' Ask the user to select an Outlook folder to process
Dim olPurgeFolder As Outlook.MAPIFolder
Set olPurgeFolder = Outlook.GetNamespace("MAPI").PickFolder
If olPurgeFolder Is Nothing Then Exit Sub
' Iteration variables
Dim msg As Outlook.MailItem
Dim att As Outlook.Attachment
Dim sSavePathFS As String
Dim sDelAtts As String
For Each msg In olPurgeFolder.Items
sDelAtts = ""
' We check each msg for attachments as opposed to using .Restrict("[Attachment] > 0")
' on our olPurgeFolder.Items collection. The collection returned by the Restrict method
' will be dynamically updated each time we remove an attachment. Each update will
' reindex the collection. As a result, it does not provide a reliable means for iteration.
' This is why the For Each style loops will not work. ~~
If msg.Attachments.Count > 0 Then
' This While loop is controlled via the .Delete method which
' will decrement msg.Attachments.Count by one each time. ~~
While msg.Attachments.Count > 0
' Save the attachment to the file system
sSavePathFS = fsSaveFolder.Self.path & "\" & msg.Attachments(1).filename
msg.Attachments(1).SaveAsFile sSavePathFS
' Build up a string to denote the file system save path(s)
' Format the string according to the msg.BodyFormat.
If msg.BodyFormat <> olFormatHTML Then
sDelAtts = sDelAtts & vbCrLf & "<file://" & sSavePathFS & ">"
Else
sDelAtts = sDelAtts & "<br>" & "<a href='file://" & sSavePathFS & "'>" & sSavePathFS & "</a>"
End If
' Delete the current attachment. We use a "1" here instead of an "i"
' because the .Delete method will shrink the size of the msg.Attachments
' collection for us. Use some well placed Debug.Print statements to see
' the behavior. ~~
msg.Attachments(1).Delete
Wend
' Modify the body of the msg to show the file system location of
' the deleted attachments.
If msg.BodyFormat <> olFormatHTML Then
msg.Body = msg.Body & vbCrLf & vbCrLf & "Attachments Deleted: " & Date & " " & Time & vbCrLf & vbCrLf & "Saved To: " & vbCrLf & sDelAtts
Else
msg.HTMLBody = msg.HTMLBody & "<p></p><p>" & "Attachments Deleted: " & Date & " " & Time & vbCrLf & vbCrLf & "Saved To: " & vbCrLf & sDelAtts & "</p>"
End If
' Save the edits to the msg. If you forget this line, the attachments will not be deleted. ~~
msg.Save
End If
Next
End Sub
Drop the pickfolder code and select the items first.
' http://msdn.microsoft.com/en-us/library/office/aa171941(v=office.11).aspx
Untested code
Sub SaveOLSelectedItemsAttachments()
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim x As Integer
Set myOlExp = Application.ActiveExplorer
Set myOlSel = myOlExp.Selection
' Ask the user to select a file system folder for saving the attachments
Dim oShell As Object
Set oShell = CreateObject("Shell.Application")
Dim fsSaveFolder As Object
Set fsSaveFolder = oShell.BrowseForFolder(0, "Please Select a Save Folder:", 1)
If fsSaveFolder Is Nothing Then Exit Sub
' Note: BrowseForFolder doesn't add a trailing slash
For x = 1 To myOlSel.Count
' Iteration variables
Dim att As Outlook.Attachment
Dim sSavePathFS As String
Dim sDelAtts As String
Dim msg as mailitem
Set msg = myOlSel.Item(x)
sDelAtts = ""
' We check the item for attachments.
' The collection returned by the Restrict method
' will be dynamically updated each time we remove an attachment. Each update will
' reindex the collection. As a result, it does not provide a reliable means for iteration.
' This is why the For Each style loops will not work. ~~
If msg.Attachments.Count > 0 Then
' This While loop is controlled via the .Delete method which
' will decrement msg.Attachments.Count by one each time. ~~
While msg.Attachments.Count > 0
' Save the attachment to the file system
sSavePathFS = fsSaveFolder.Self.path & "\" & msg.Attachments(1).filename
msg.Attachments(1).SaveAsFile sSavePathFS
' Build up a string to denote the file system save path(s)
' Format the string according to the msg.BodyFormat.
If msg.BodyFormat <> olFormatHTML Then
sDelAtts = sDelAtts & vbCrLf & "<file://" & sSavePathFS & ">"
Else
sDelAtts = sDelAtts & "<br>" & "<a href='file://" & sSavePathFS & "'>" & sSavePathFS & "</a>"
End If
' Delete the current attachment. We use a "1" here instead of an "i"
' because the .Delete method will shrink the size of the msg.Attachments
' collection for us. Use some well placed Debug.Print statements to see
' the behavior. ~~
msg.Attachments(1).Delete
Wend
' Modify the body of the msg to show the file system location of
' the deleted attachments.
If msg.BodyFormat <> olFormatHTML Then
msg.Body = msg.Body & vbCrLf & vbCrLf & "Attachments Deleted: " & Date & " " & Time & vbCrLf & vbCrLf & "Saved To: " & vbCrLf & sDelAtts
Else
msg.HTMLBody = msg.HTMLBody & "<p></p><p>" & "Attachments Deleted: " & Date & " " & Time & vbCrLf & vbCrLf & "Saved To: " & vbCrLf & sDelAtts & "</p>"
End If
' Save the edits to the msg. If you forget this line, the attachments will not be deleted. ~~
msg.Save
End If
Next
Next x
End Sub
My registering here is a strong testimony to the excellent answers I've found here before.
I hope someone can help me with what feels like it should be a simple issue, if not, I fear for rapidly increasing baldness.
I've created an HTA file to perfom file operations, renaming, copying, adding on the date, etc.
My problem is that I have several variables who are set equal to file paths that include spaces. other variables are set to user input, which will include spaces. These variables are then used in other lines of code. But those other lines break when they encouter the space in the "extended" varable.
For examples, here is one line in particular driving me up the wall.
Sub makemp3
If mp3radio(0).Checked Then
Set objShell = CreateObject("Wscript.Shell")
objShell.Run "cmd.exe /c " &lameexe& " " &defaultpathfile& " " &sermonmp3folder& "\" &newfile& ".mp3"
Else
End If
End Sub
In the above case, the variables are set at the beginning of the script block to...
lameexe="D:\LAME\lame3.99.5-libsndfile\lame.exe"
defaultpathfile = sermonflacfolder&"\"&defaultflac
sermonmp3folder = "D:\SermonMP3"
newfile = datebox.value&"_"& titlebox.value
The databox is poplulated by a sub...
'pouplate input boxes with variables as default text
'==============================================
sub Window_onload
Set WshShell = CreateObject("WScript.Shell")
Set ObjEnv = WshShell.Environment("Process")
datebox.value = calcdate
end sub
calcdate, in turn is created by another sub...
'setup and perform date calculations
'======================================
days=DatePart("d", now)
monthdig=DatePart("m", now)
years=DatePart("yyyy", now)
amps=Hour(now)
If monthdig <10 Then months="0"&monthdig Else months=monthdig
If amps <15 Then apm="am" Else apm="pm"
calcdate = years&"_"&months&"_"&days&"_"&apm
titlebox is currently just user input... the expected input would be similar to
What are we here for
or
Rev Phillip Smith
In all the reading I've done online, there is something I'm just not understanding about escaping quotes, double quotes, and chr(34).
this page seems hopeful, but I couldn't make it work with the variables in my script.
http://groups.google.com/group/microsoft.public.scripting.vbscript/browse_thread/thread/2ca422f55628ea5e
Also, this page was the most verbal on the subject, but still it didn't show about using variable which themselves have no spaces, but the string inside them do.
groups.google.com/group/microsoft.public.scripting.vbscript/browse_thread/thread/2ca422f55628ea5e
I'm all out of brain power... Please help.
Thanks,
David
<script language="VBScript">
'
'
'deleteoldreapertemp subroutine adapted from:
'http://groups.google.com/group/microsoft.public.scripting.wsh/msg/14df6623fc552446
'
'
'explaination of variables...
'
'windowwidth... the desired width of the script window
'windowlength... the desired length of the script window
'sermonflacfolder... the desired location reaper renders the sermon file to
'defaultflac... this is the name used when the sermon file is rendered
'calcdate... uses date variables to create the default flac file name
'defaultpathfile... a shortcut to use intead of sermonflacfolder&"\"&defaultflac
'tempdir... where reaper stores its temp files
'killdate... files older than this value will be deleted from reaper temp directory
'Manually set variables
'=================================
windowwidth = 400
windowlength = 500
sermonflacfolder= "D:\SermonFLAC"
defaultflac="test.flac"
defaultpathfile = sermonflacfolder&"\"&defaultflac
tempdir = "D:\reaper temp dir"
sermonmp3folder = "D:\SermonMP3"
lameexe="D:\LAME\lame3.99.5-libsndfile\lame.exe"
killdaysold = 14
'setup and perform date calculations
'======================================
days=DatePart("d", now)
monthdig=DatePart("m", now)
years=DatePart("yyyy", now)
amps=Hour(now)
If monthdig <10 Then months="0"&monthdig Else months=monthdig
If amps <15 Then apm="am" Else apm="pm"
calcdate = years&"_"&months&"_"&days&"_"&apm
killdate = date() &" - "& killdaysold
'resize script window before it is drawn... avoids flicker
'==========================================
Sub resizewindow
window.resizeTo windowwidth,windowlength
end Sub
resizewindow()
'position script window at center of screen
'============================================
sub centerwindow
screenWidth = Document.ParentWindow.Screen.AvailWidth
screenHeight = Document.ParentWindow.Screen.AvailHeight
posLeft = (screenWidth - windowwidth) / 2
posTop = (screenHeight - windowlength) / 2
'move to centerscreen
window.moveTo posLeft, posTop
end sub
centerwindow()
'pouplate input boxes with variables as default text
'==============================================
sub Window_onload
Set WshShell = CreateObject("WScript.Shell")
Set ObjEnv = WshShell.Environment("Process")
datebox.value = calcdate
end sub
</script>
<head>
<title>HTA Test</title>
<HTA:APPLICATION
APPLICATIONNAME="RENAMER"
SCROLL="NO">
</head>
<body>
<body bgcolor=c0c0c0>
<!text boxes setup here>
<!=====================================================================>
<p>
Accept calculated date and service (am or pm)<br>
or input correct date and service<br>
(yyyy_mm_dd_am)<br>
<input type="text" name="datebox" onclick="datebox.value=''">
<p>
<br>
Input sermon title <br>
<input type="text" name="titlebox" onfocus="titlebox.value=''">
<input type="button" name="examplesbutton" value="Examples" onClick="examplesclick" style="float: right;">
<br>
<br>
Create archive MP3?
<br>
Yes<input type="radio" name="mp3Radio" value="1" checked="true">
No<input type="radio" name="mp3Radio" value="2">
<p>
Shutdown computer when script finishes?
<br>
Yes<input type="radio" name="shutdownRadio" value="1" checked="true">
No<input type="radio" name="shutdownRadio" value="2" >
<br>
<br>
<br>
<input type="button" name="settingsbutton" value="Settings" onClick="settingsclick" style="float: left;">
<input type="button" name="runbutton" value="Run Script" onClick="MASTERSUB" style="float: right;">
<p>
</body>
<script language="VBScript">
'CHECKING "DOES DEFAULT SERMON FILE EXIST?"
'=========================================
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(defaultpathfile)) Then
Else
Msgbox "Default sermon file not found at:" & vbnewline & sermonflacfolder & "\" & defaultflac & vbnewline & vbnewline & "Check settings in Reaper (File\Render menu)" & vbnewline & vbnewline & "Click Ok to exit script"
exitscript()
End If
Sub MASTERSUB
lastchance
deleteoldreapertemp
rename
makemp3
checkfornewflac
checkfornewmp3
deletedefaultflac
shutdownsub
End Sub
'MASTERSUB runs all the contained sub subs
'=====================================================
'=====================================================
'=====================================================
dim shutdownverify
dim newfile
dim newflacfound
dim newmp3found
Sub Delay ( seconds )
Dim wshShell
Set wshShell = CreateObject( "WScript.Shell" )
wshShell.Run "ping -n " & ( seconds + 1 ) & " 127.0.0.1", 0, True
Set wshShell = Nothing
End Sub
'last chance to abort shutdown
'=====================================================
Sub lastchance
If shutdownradio(0).Checked Then
lastchanceanswer = _
Msgbox("Computer will shutdown when script finishes", _
vbYesNo, "Last chance to abort shutdown")
If lastchanceanswer = vbYes Then
shutdownverify = "yes"
Else
shutdownverify = "no"
End If
Else
End If
End Sub
'attempt to rename defaultflac
'=======================================================
Sub rename
newfile = datebox.value&"_"& titlebox.value
Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.CopyFile defaultpathfile , sermonflacfolder&"\"&newfile&".flac"
End Sub
'encode an mp3 version of the defaultflac file (only if the "yes" mp3 radio button is checked)
'===============================================
Sub makemp3
If mp3radio(0).Checked Then
Set objShell = CreateObject("Wscript.Shell")
objShell.Run "cmd.exe /c " &lameexe& " " &defaultpathfile& " " &sermonmp3folder& "\" &newfile& ".mp3"
Else
End If
End Sub
'check if new flac is was created successfully
'===============================================
Sub checkfornewflac
Delay 10
Dim count
count = 1
Do
If (fso.FileExists(sermonflacfolder&"\"&datebox.value&"_"&titlebox.value&".flac")) Then
newflacfound = "yes"
'msgbox "new flac file found flag set to "&newflacfound
Exit Sub
Else
count=count+1
If count >4 Then
newflacfound = "no"
'msgbox "new flac not found, flag set to "&newflacfound
Exit Sub
Else
End If
Delay 10
End If
Loop
End Sub
'check if mp3 was created sucessfully
'===============================================
Sub checkfornewmp3
Dim count
count = 1
If mp3radio(0).Checked Then
Do
If (fso.FileExists(sermonmp3folder&"\" & newfile & ".mp3")) Then
newmp3found = "yes"
'msgbox "new mp3 file found flag set to "&newmp3found
Exit Sub
Else
count=count+1
If count >4 Then
newmp3found = "no"
'msgbox "new mp3 not found, flag set to "&newmp3found
Exit Sub
Else
End If
Delay 10
End If
Loop
End If
End Sub
'Delete default file
'=============================================
Sub deletedefaultflac
Delay 90
If newflacfound = "yes" Then
If newmp3found = "yes" Then
set objFSO = createobject("Scripting.FileSystemObject")
objFSO.DeleteFile defaultpathfile
Else
set objFSO = createobject("Scripting.FileSystemObject")
objFSO.MoveFile defaultpathfile , sermonflacfolder&"\"& "aaERROR" &newfile&".flac"
End If
Else
set objFSO = createobject("Scripting.FileSystemObject")
objFSO.MoveFile defaultpathfile , sermonflacfolder&"\"& "00000_ERROR_" &newfile&".flac"
End If
End Sub
'Delete old reaper temp files
'===========================================
Sub deleteoldreapertemp
'msgbox "starting 1sub"
arFiles = Array()
set fso = createobject("scripting.filesystemobject")
selectfiles path, killdate, arFiles, true
nDeleted = 0
for n = 0 to ubound(arFiles)
'=================================================
' Files deleted via FSO methods do *NOT* go to the recycle bin!!!
'=================================================
on error resume next 'in case of 'in use' files...
arFiles(n).delete true
if err.number <> 0 then
wscript.echo "Unable to delete: " & arFiles(n).path
else
nDeleted = nDeleted + 1
end if
on error goto 0
next
'msgbox nDeleted & " of " & ubound(arFiles)+1 _
' & " eligible files were deleted"
'msgbox "end 1 sub"
End Sub
sub selectfiles(sPath,vKillDate,arFilesToKill,bIncludeSubFolders)
set folder = fso.getfolder(tempdir)
set files = folder.files
'msgbox "startng 2 sub"
on error resume next
for each file in files
' uses error trapping around access to the
' Date property just to be safe
'
dtlastmodified = null
on error resume Next
dtlastmodified = file.datelastmodified
on error goto 0
if not isnull(dtlastmodified) Then
if dtlastmodified < vKillDate then
count = ubound(arFilesToKill) + 1
redim preserve arFilesToKill(count)
set arFilesToKill(count) = file
end if
end if
next
if bIncludeSubFolders then
for each fldr in folder.subfolders
SelectFiles fldr.path,vKillDate,arFilesToKill,true
next
end if
end sub
'shutdown computer (only if the "yes" shutdown radio button is checked)
'=======================================================================
Sub shutdownsub
If shutdownverify= "yes" Then
Set objShell = CreateObject("Wscript.Shell")
'msgbox "shutdown ran!"
objShell.Run "shutdown.exe -s -t 5"
Else
exitscript
End If
End Sub
'=====================================================
'=====================================================
'=====================================================
'clicking the "settings" button runs this routine
'===================================================
Sub settingsclick
Msgbox "Default sermon filename is set to: " & defaultflac & vbnewline & "Storage area for sermon flacs is set to: " & sermonflacfolder & vbnewline & "Storage location for sermon mp3's set to: " & sermonmp3folder & vbnewline & "Path to Lame.exe (with flac support) set to: " & lameexe & vbnewline
End Sub
'clicking the "Examples" button runs this routine
'===================================
Sub examplesclick
Msgbox "Capitalize the first letter of the sermon title" & vbNewLine & "Capitalize the names of God" & vbNewLine & "For guest speaker, use their name as the title" & vbNewLine & "Here are some examples:"& vbNewLine & vbNewLine &"What hath God wrought"& vbNewLine & "The ABCs of life" & vbNewLine & "Dr Jimmy Stewart"
End Sub
'if no defaultflac file found, exit script
'=========================================
Sub exitscript
window.close
End Sub
</script>
Paths containing spaces in a command line should be enclosed in double quotes. In VBScript you can double up quotes and they will parse into your string, but this ends up being very hard to read. I suggest appending the intrinsic constant vbQuote or using Chr(34) which both return a literal ".
objShell.Run "cmd.exe /c " & lameexe & " " & Chr(34) & defaultpathfile & Chr(34) & " " & Chr(34) & sermonmp3folder& "\" &newfile& ".mp3" & Chr(34)
The crucial parts are:
Chr(34) & defaultpathfile & Chr(34)
and
Chr(34) & sermonmp3folder& "\" &newfile& ".mp3" & Chr(34)
Notice how I'm surrounding the file paths with the double quote characters. This will return strings that include the double quotes.
Your reading has sort of steered you in the wrong direction. Don't think of this as escaping quotes. You are actually inserting them into your string.