I have this code, my objective is to copy and paste a folder (with all its content) from a current template folder to paste onto a destination file path that is based on the field values as a condition to the new file destination name.
I am receiving an error:
FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
Not sure why, can you please help. Thank you.
Private Sub Command83_Click()
Dim FSO As Object
Dim FromPath As String
Dim ToPath As String
FromPath = "C:\Database Test Center\Master" '<< Change
ToPath = "C:\Database Test Center\Projects\" & Me.ProjectName.Value & "-" &
Me.Lead.Value & "\MasterTemplate"
If Right(FromPath, 1) = "\" Then
FromPath = Left(FromPath, Len(FromPath) - 1)
End If
If Right(ToPath, 1) = "\" Then
ToPath = Left(ToPath, Len(ToPath) - 1)
End If
Set FSO = CreateObject("scripting.filesystemobject")
If FSO.FolderExists(FromPath) = False Then
MsgBox FromPath & " doesn't exist"
Exit Sub
End If
FSO.CopyFile Source:=FromPath & FileExt, Destination:=ToPath
MsgBox "You can find the files from " & FromPath & " in " & ToPath
End Sub
Related
I need a VBScript that will check if a process is in use by a specific user:
Agent clicks program icon --> batch file calls for progcheck.vbs -->
progcheck.vbs looks to see is "whatever.exe" is running under that user only -->
if program is running under that user then MsgBox "Program running" --> wscript.quit (this needs to terminate out of the batch file)
else --> return to batch file.
I have tried this with tasklist in a batch file and the script works, but takes forever to run for a domain user. Want to do this in vbscript anyway.
*** UPDATED SCRIPT WITH MODS 10/12 *****
OPTION EXPLICIT
DIM strComputer,strProcess, strUserName,wshShell
Set wshShell = WScript.CreateObject( "WScript.Shell" )
strUserName = wshShell.ExpandEnvironmentStrings( "%USERNAME%" )
strComputer = "." '
strProcess = "notepad.exe"
IF isProcessRunning(strComputer,strProcess,strUserName) THEN
If MsgBox ("Notepad needs to be closed.", 1) = 1 then
wscript.Quit(1)
End If
END IF
FUNCTION isProcessRunning(BYVAL strComputer,BYVAL strProcessName,BYVAL strUserName)
DIM objWMIService, strWMIQuery
strWMIQuery = "Select * from Win32_Process where name like '" & strProcessName & "' AND owner like '" &strUserName& "'"
SET objWMIService = GETOBJECT("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
IF objWMIService.ExecQuery(strWMIQuery).Count > 0 THEN
isProcessRunning = TRUE
ELSE
isProcessRunning = FALSE
END If
End Function
Let me know what you think and where I have it wrong. Thanks in advance.
UPDATED CODE v3: review comments for help
OPTION EXPLICIT
DIM strComputer, strProcess, strUserName, wshShell
Set wshShell = WScript.CreateObject( "WScript.Shell" )
strUserName = wshShell.ExpandEnvironmentStrings( "%USERNAME%" )
strComputer = "."
strProcess = "notepad.exe" 'change this to whatever you are trying to detect
IF isProcessRunning(strComputer, strProcess, strUserName) THEN
If MsgBox ("Notepad needs to be closed.", 1) = 1 then
wscript.Quit(1) 'you need to terminate the process if that's your intention before quitting
End If
Else
msgbox ("Process is not running") 'optional for debug, you can remove this
END IF
FUNCTION isProcessRunning(ByRef strComputer, ByRef strProcess, ByRef strUserName)
DIM objWMIService, strWMIQuery, objProcess, strOwner, Response
strWMIQuery = "SELECT * FROM Win32_Process WHERE NAME = '" & strProcess & "'"
SET objWMIService = GETOBJECT("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2").ExecQuery(strWMIQuery)
IF objWMIService.Count > 0 THEN
msgbox "We have at least ONE instance of Notepad"
For Each objProcess in objWMIService
Response = objProcess.GetOwner(strOwner)
If Response <> 0 Then
'we didn't get any owner information - maybe not permitted by current user to ask for it
Wscript.Echo "Could not get owner info for process [" & objProcess.Name & "]" & VBNewLine & "Error: " & Return
Else
Wscript.Echo "Process [" & objProcess.Name & "] is owned by [" & strOwner & "]" 'for debug you can remove it
if strUserName = strOwner Then
msgbox "we have the user who is running notepad"
isProcessRunning = TRUE
Else
'do nothing as you only want to detect the current user running it
isProcessRunning = FALSE
End If
End If
Next
ELSE
msgbox "We have NO instance of Notepad - Username is Irrelevant"
isProcessRunning = FALSE
END If
End Function
You can use the following function:
FUNCTION isProcessRunning(BYVAL strComputer,BYVAL strProcessName)
DIM objWMIService, strWMIQuery
strWMIQuery = "Select * from Win32_Process where name like '" & strProcessName & "'"
SET objWMIService = GETOBJECT("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
IF objWMIService.ExecQuery(strWMIQuery).Count > 0 THEN
isProcessRunning = TRUE
ELSE
isProcessRunning = FALSE
END IF
END FUNCTION
For local computer you would use "."
For the process name, you would use the executable "notepad.exe"
For the rest of the code, you could can use something simple:
OPTION EXPLICIT
DIM strComputer,strProcess
strComputer = "." ' local computer
strProcess = "notepad.exe" 'whatever is the executable
IF isProcessRunning(strComputer,strProcess) THEN
'do something
ELSE
'do something else or nothing
wscript.echo strProcess & " is NOT running on computer '" & strComputer & "'"
END IF
That should do it.
EXTRA
To show every process running, then just run:
Option Explicit
Dim objWMIService, objProcess, colProcess
Dim strComputer, strList
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
Set colProcess = objWMIService.ExecQuery _
("Select * from Win32_Process")
For Each objProcess in colProcess
strList = strList & vbCr & _
objProcess.Name
Next
WSCript.Echo strList
WScript.Quit
in terminal server this function can be very slow, all the GetOwner calls are terrible in performance.
A very fast solution i created is to narrow the query using SessionID of the current user (assuming we want only current user's processes) So I added this code:
SessionID can be obtained this way:
Dim oExec, sOutput, iUserPos, iUserLen, iStatePos, SessionID
dim oShell, userName
Set oShell = CreateObject("Wscript.Shell")
userName = oShell.ExpandEnvironmentStrings("%USERNAME%")
Set oExec = oShell.Exec("query session %username%")
sOutput = LCase(oExec.StdOut.ReadAll)
iUserPos = InStr(sOutput, LCase(userName))
iStatePos = InStr(sOutput, "active")
iUserLen = Len(userName)
SessionID = CInt(Trim(Mid(sOutput, iUserPos+iUserLen, iStatePos-iUserPos-iUserLen)))
Changed the function from the previous post:
Function isProcessRunning(ByRef strComputer, ByRef strProcess, ByRef strUserName, byRef sessionID)
DIM objWMIService, strWMIQuery, objProcess, strOwner, Response
strWMIQuery = "SELECT * FROM Win32_Process WHERE SessionId = " & sessionID & " And NAME = '" & strProcess & "'"
SET objWMIService = GETOBJECT("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2").ExecQuery(strWMIQuery)
IF objWMIService.Count > 0 THEN
'msgbox "We have at least ONE instance of Notepad"
For Each objProcess in objWMIService
Response = objProcess.GetOwner(strOwner)
If Response = 0 Then
'Wscript.Echo "Process [" & objProcess.Name & "] is owned by [" & strOwner & "]" 'for debug you can remove it
if strUserName = strOwner Then
'msgbox "we have the user who is running notepad"
isProcessRunning = TRUE
Else
'do nothing as you only want to detect the current user running it
isProcessRunning = FALSE
End If
'else
'we didn't get any owner information - maybe not permitted by current user to ask for it
'Wscript.Echo "Could not get owner info for process [" & objProcess.Name & "]" & VBNewLine & "Error: " & Return
End If
Next
ELSE
'msgbox "We have NO instance of Notepad - Username is Irrelevant"
isProcessRunning = FALSE
END If
End Function
It might be a little funny but I am facing some stupid issue.
I am using
File.Create(ConfigurationManager.AppSettings("LogFilePath1")).Dispose()
and
Using writer As StreamWriter = File.AppendText(context.Current.Server.MapPath(ConfigurationManager.AppSettings("LogFilePath1")))
when I using this the error is given to me is "Could not find a part of the path "
If am storing the path in a string then its working fine else producing error.
For your reference I am copying my function code snippet.
Please help
Thanks
Public Shared Function LogErrorToLogFile(ByVal ee As Exception, ByVal userFriendlyError As String) As String
Try
Dim path As String = context.Current.Server.MapPath(ConfigurationManager.AppSettings("LogFilePath1"))
' check if directory exists
If Not Directory.Exists(path) Then
'Directory.CreateDirectory(path)
Directory.CreateDirectory(context.Current.Server.MapPath(ConfigurationManager.AppSettings("LogFilePath1")))
End If
path = path & DateTime.Today.ToString("dd-MMM-yy") & ".log"
' check if file exist
If Not File.Exists(path) Then
File.Create(path).Dispose()
'File.Create(context.Current.Server.MapPath(ConfigurationManager.AppSettings("LogFilePath1"))).Dispose()
File.Create(ConfigurationManager.AppSettings("LogFilePath1")).Dispose()
End If
' log the error now
Using writer As StreamWriter = File.AppendText(path)
'Using writer As StreamWriter = File.AppendText(context.Current.Server.MapPath(ConfigurationManager.AppSettings("LogFilePath1")))
writer.WriteLine(HttpUtility.HtmlEncode(vbCr & vbLf & "Log written at : " & DateTime.Now.ToString() & vbCr & vbLf & "Error occured on page : " & context.Current.Request.Url.ToString() & vbCr & vbLf & vbCr & vbLf & "Here is the actual error :" & vbLf & ee.ToString()))
writer.WriteLine("==========================================")
writer.Flush()
writer.Close()
End Using
Return userFriendlyError
Catch
Throw
End Try
End Function
If you change the current lines with the comment-outed lines in your function code snippet, you're logic is changed because when you use Path, there is added a filename [dd-MMM-yy].log to the path-string. but you don't use that addition when you use the ConfigurationManager.AppSettings("LogFilePath1") directly!
I assume that you have not used the folder path with slash (ex: #"C:\FolderName\") and that is the reason you are getting the error.
I am running multiple perl scripts (about 2-5) within a ASP.net page using VB.net. The scripts are executing just fine. The script is returning the DNS name and other information of the UNIX server to ensure we have it configured correctly.
I need to output the Perl results to VB.net so I can show the results in the main page (and color code depending on success/failure).
Any suggestions?
EDIT:
Showing my code
If rdoUnix.Checked Then
runUnixScript("testScript.pl", UNIXUSERNAME, UNIXPASSWORD)
End If
End If
End Sub
Public Sub runUnixScript(ByVal SCRIPT As String, ByVal UNIXUSERNAME As String, ByVal UNIXPASSWORD As String)
Dim COMPUTERNAME As String = FQDN.Text
Dim virtualFolder As String = "~/Scripts"
Dim physicalFolder As String = Server.MapPath(virtualFolder)
Dim processCmdFileTransfer As String = "/K C:\pscp.exe -pw " & UNIXPASSWORD & " " & physicalFolder & "\" & SCRIPT & " " & UNIXUSERNAME & "#" & COMPUTERNAME & ":" & SCRIPT
Dim processCmdFileActions As String = "-ssh -pw " & UNIXPASSWORD & " " & UNIXUSERNAME & "#" & COMPUTERNAME & "XX" & SCRIPT
' Transfers Script, Makes it executable, Runs Script and then deletes script
RunProcess("C:\Windows\System32\cmd.exe", processCmdFileTransfer, SCRIPT)
RunProcess("C:\plink.exe", processCmdFileActions, SCRIPT, " chmod u+x ./")
RunProcess("C:\plink.exe", processCmdFileActions, SCRIPT, " ./")
RunProcess("C:\plink.exe", processCmdFileActions, SCRIPT, " rm ./")
End Sub
Public Sub RunProcess(ByVal processPath As String, ByVal startInfo As String, ByVal script As String, Optional ByVal command As String = "")
Dim Proc As New System.Diagnostics.Process
Proc.StartInfo = New ProcessStartInfo(processPath)
If (InStr(startInfo, "XX") > 0) And (command <> "") Then
startInfo = startInfo.Replace("XX", command)
End If
Proc.StartInfo.Arguments = startInfo
Proc.StartInfo.RedirectStandardInput = True
Proc.StartInfo.RedirectStandardOutput = False
Proc.StartInfo.UseShellExecute = False
Proc.StartInfo.CreateNoWindow = True
Proc.Start()
Proc.WaitForExit()
End Sub
Try redirecting the output of the executed code using output redirection.
Just pass the perl executable the path of the perlscript in the following line
Dim psI As New ProcessStartInfo("PERL_INSTALLED\\perl.exe SCRIPT_DIR\\MyScript.pl");
Is there any way to create an excel spreadsheets using VBScript? I can create a text file using a FileSystemObject and use any extension I want, but when I try and download this and it gives me the open in excel option a message then appears stating that it is in a different format, and that is what I want to avoid:
set fs=Server.CreateObject("Scripting.FileSystemObject")
set tfile=fs.CreateTextFile(Server.MapPath("xls/streamtest.xls"),true,false)
I know this is pushing text into the file in ASCII format.
Is there 'something' character sequence, specific formatting that I can use to get around all of this?
Thanks
The best and fastest way, without using Excel.application on the server, which is really not recommended, is to generate an Excel Xml file. The only feature you won't be able to do is insert a picture.
Unlike using html table, you'll be able to support native data in excel (like date), and you'll be able to format, insert formula, ...
Save your excel as Excel XML and see the generate XML file. This is little bit tricky, but works very well.
Microsoft .xlsx files are just a Zipped collection of xml files
That means that we can write out the xml files and folder structure as text files, the zip the folder and rename that zip file to .xlsx. Now we have a new, empty excel file. Here is my code to do just that without having to have MS Excel installed.
The ZipAFolder function has been modified from another stackoverflow question here
'
' Dependencies: ZipAFolder, moveFile, writeToFile, Environ, OpenWithExplorer, FileExists, FolderExists, ScriptEngine, MkDir
' Version: 1.0.0
' by jeremy.gerdes#navy.mil
' CC0 1.0 Universal (CC0 1.0) Public Domain Dedication
' [TODO] reset the file attributes of date - Created, Modified, and Accessed to 12/31/1979 11:00 PM (for eastern time zone) to all files
' Usage example
' BuildEmptyExcelFile GetCurrentFileFolder() & "\" & "anEmptyExcelFile.xlsx"
Public Sub BuildEmptyExcelFile(strNewExcelFile)
Dim strLocalAppTmp
strLocalAppTmp = Environ("LocalAppData") & "\" & "tmp"
MkDir strLocalAppTmp
Dim strTmpZipPath
strTmpZipPath = strLocalAppTmp & "\" & "buildEmptyExcelFile"
MkDir strTmpZipPath
WriteToFile strTmpZipPath & "\" & "[Content_Types].xml" , _
"<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & _
"<Types xmlns=""http://schemas.openxmlformats.org/package/2006/content-types""><Default Extension=""rels"" ContentType=""application/vnd.openxmlformats-package.relationships+xml""/><Default Extension=""xml"" ContentType=""application/xml""/><Override PartName=""/xl/workbook.xml"" ContentType=""application/vnd.openxmlformats-officedocument.spreadsheetml.sheet.main+xml""/><Override PartName=""/xl/worksheets/sheet1.xml"" ContentType=""application/vnd.openxmlformats-officedocument.spreadsheetml.worksheet+xml""/><Override PartName=""/xl/theme/theme1.xml"" ContentType=""application/vnd.openxmlformats-officedocument.theme+xml""/><Override PartName=""/xl/styles.xml"" ContentType=""application/vnd.openxmlformats-officedocument.spreadsheetml.styles+xml""/><Override PartName=""/docProps/core.xml"" ContentType=""application/vnd.openxmlformats-package.core-properties+xml""/><Override PartName=""/docProps/app.xml"" ContentType=""application/vnd.openxmlformats-officedocument.extended-properties+xml""/></Types>", _
False, True
MkDir strTmpZipPath & "\" & "_rels"
WriteToFile _
strTmpZipPath & "\" & "_rels" & "\" & ".rels" , _
"<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?><Relationships xmlns=""http://schemas.openxmlformats.org/package/2006/relationships""><Relationship Id=""rId3"" Type=""http://schemas.openxmlformats.org/officeDocument/2006/relationships/extended-properties"" Target=""docProps/app.xml""/><Relationship Id=""rId2"" Type=""http://schemas.openxmlformats.org/package/2006/relationships/metadata/core-properties"" Target=""docProps/core.xml""/><Relationship Id=""rId1"" Type=""http://schemas.openxmlformats.org/officeDocument/2006/relationships/officeDocument"" Target=""xl/workbook.xml""/></Relationships>", _
False, True
MkDir strTmpZipPath & "\" & "docProps"
WriteToFile _
strTmpZipPath & "\" & "docProps" & "\" & "app.xml" , _
"<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?><Properties xmlns=""http://schemas.openxmlformats.org/officeDocument/2006/extended-properties"" xmlns:vt=""http://schemas.openxmlformats.org/officeDocument/2006/docPropsVTypes""><Application>Microsoft Excel</Application><DocSecurity>0</DocSecurity><ScaleCrop>false</ScaleCrop><HeadingPairs><vt:vector size=""2"" baseType=""variant""><vt:variant><vt:lpstr>Worksheets</vt:lpstr></vt:variant><vt:variant><vt:i4>1</vt:i4></vt:variant></vt:vector></HeadingPairs><TitlesOfParts><vt:vector size=""1"" baseType=""lpstr""><vt:lpstr>Sheet1</vt:lpstr></vt:vector></TitlesOfParts><Company>HPES NMCI NGEN</Company><LinksUpToDate>false</LinksUpToDate><SharedDoc>false</SharedDoc><HyperlinksChanged>false</HyperlinksChanged><AppVersion>16.0300</AppVersion></Properties>", _
False, True
WriteToFile _
strTmpZipPath & "\" & "docProps" & "\" & "core.xml" , _
"<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?><cp:coreProperties xmlns:cp=""http://schemas.openxmlformats.org/package/2006/metadata/core-properties"" xmlns:dc=""http://purl.org/dc/elements/1.1/"" xmlns:dcterms=""http://purl.org/dc/terms/"" xmlns:dcmitype=""http://purl.org/dc/dcmitype/"" xmlns:xsi=""http://www.w3.org/2001/XMLSchema-instance""><dc:creator>jeremy.gerdes</dc:creator><cp:lastModifiedBy>jeremy.gerdes</cp:lastModifiedBy><dcterms:created xsi:type=""dcterms:W3CDTF"">2021-04-09T02:10:55Z</dcterms:created><dcterms:modified xsi:type=""dcterms:W3CDTF"">2021-04-09T02:11:30Z</dcterms:modified></cp:coreProperties>", _
False, True
MkDir strTmpZipPath & "\" & "xl"
MkDir strTmpZipPath & "\" & "xl" & "\" & "theme"
WriteToFile _
strTmpZipPath & "\" & "xl" & "\" & "styles.xml", _
"<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & _
"<styleSheet xmlns=""http://schemas.openxmlformats.org/spreadsheetml/2006/main"" xmlns:mc=""http://schemas.openxmlformats.org/markup-compatibility/2006"" mc:Ignorable=""x14ac x16r2"" xmlns:x14ac=""http://schemas.microsoft.com/office/spreadsheetml/2009/9/ac"" xmlns:x16r2=""http://schemas.microsoft.com/office/spreadsheetml/2015/02/main""><fonts count=""1"" x14ac:knownFonts=""1""><font><sz val=""11""/><color theme=""1""/><name val=""Calibri""/><family val=""2""/><scheme val=""minor""/></font></fonts><fills count=""2""><fill><patternFill patternType=""none""/></fill><fill><patternFill patternType=""gray125""/></fill></fills><borders count=""1""><border><left/><right/><top/><bottom/><diagonal/></border></borders><cellStyleXfs count=""1""><xf numFmtId=""0"" fontId=""0"" fillId=""0"" borderId=""0""/></cellStyleXfs><cellXfs count=""1""><xf numFmtId=""0"" fontId=""0"" fillId=""0"" borderId=""0"" xfId=""0""/></cellXfs><cellStyles count=""1""><cellStyle name=""Normal"" xfId=""0"" builtinId=""0""/></cellStyles>" & _
"<dxfs count=""0""/><tableStyles count=""0"" defaultTableStyle=""TableStyleMedium2"" defaultPivotStyle=""PivotStyleLight16""/><extLst><ext uri=""{EB79DEF2-80B8-43e5-95BD-54CBDDF9020C}"" xmlns:x14=""http://schemas.microsoft.com/office/spreadsheetml/2009/9/main""><x14:slicerStyles defaultSlicerStyle=""SlicerStyleLight1""/></ext><ext uri=""{9260A510-F301-46a8-8635-F512D64BE5F5}"" xmlns:x15=""http://schemas.microsoft.com/office/spreadsheetml/2010/11/main""><x15:timelineStyles defaultTimelineStyle=""TimeSlicerStyleLight1""/></ext></extLst></styleSheet>", _
False, True
WriteToFile _
strTmpZipPath & "\" & "xl" & "\" & "workbook.xml", _
"<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & _
"<workbook xmlns=""http://schemas.openxmlformats.org/spreadsheetml/2006/main"" xmlns:r=""http://schemas.openxmlformats.org/officeDocument/2006/relationships"" xmlns:mc=""http://schemas.openxmlformats.org/markup-compatibility/2006"" mc:Ignorable=""x15"" xmlns:x15=""http://schemas.microsoft.com/office/spreadsheetml/2010/11/main""><fileVersion appName=""xl"" lastEdited=""6"" lowestEdited=""6"" rupBuild=""14420""/><workbookPr defaultThemeVersion=""164011""/><mc:AlternateContent xmlns:mc=""http://schemas.openxmlformats.org/markup-compatibility/2006""><mc:Choice Requires=""x15""><x15ac:absPath url=""\\snnsvr045\NNSY Perm\T&I Lab\NNSY IT Assistant\Documentation\"" xmlns:x15ac=""http://schemas.microsoft.com/office/spreadsheetml/2010/11/ac""/></mc:Choice></mc:AlternateContent><bookViews><workbookView xWindow=""0"" yWindow=""210"" windowWidth=""15495"" windowHeight=""6435""/></bookViews><sheets><sheet name=""Sheet1"" sheetId=""1"" r:id=""rId1""/></sheets><calcPr calcId=""162913""/><extLst>" & _
"<ext uri=""{140A7094-0E35-4892-8432-C4D2E57EDEB5}"" xmlns:x15=""http://schemas.microsoft.com/office/spreadsheetml/2010/11/main""><x15:workbookPr chartTrackingRefBase=""1""/></ext></extLst></workbook>", _
False, True
MkDir strTmpZipPath & "\" & "xl" & "\" & "_rels"
WriteToFile _
strTmpZipPath & "\" & "xl" & "\" & "_rels" & "\" & "workbook.xml.rels", _
"<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?><Relationships xmlns=""http://schemas.openxmlformats.org/package/2006/relationships""><Relationship Id=""rId3"" Type=""http://schemas.openxmlformats.org/officeDocument/2006/relationships/styles"" Target=""styles.xml""/><Relationship Id=""rId2"" Type=""http://schemas.openxmlformats.org/officeDocument/2006/relationships/theme"" Target=""theme/theme1.xml""/><Relationship Id=""rId1"" Type=""http://schemas.openxmlformats.org/officeDocument/2006/relationships/worksheet"" Target=""worksheets/sheet1.xml""/></Relationships>", _
False, True
MkDir strTmpZipPath & "\" & "xl" & "\" & "theme"
WriteToFile _
strTmpZipPath & "\" & "xl" & "\" & "theme" & "\" & "theme1.xml", _
"<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & _
"<a:theme xmlns:a=""http://schemas.openxmlformats.org/drawingml/2006/main"" name=""Office Theme""><a:themeElements><a:clrScheme name=""Office""><a:dk1><a:sysClr val=""windowText"" lastClr=""000000""/></a:dk1><a:lt1><a:sysClr val=""window"" lastClr=""FFFFFF""/></a:lt1><a:dk2><a:srgbClr val=""44546A""/></a:dk2><a:lt2><a:srgbClr val=""E7E6E6""/></a:lt2><a:accent1><a:srgbClr val=""5B9BD5""/></a:accent1><a:accent2><a:srgbClr val=""ED7D31""/></a:accent2><a:accent3><a:srgbClr val=""A5A5A5""/></a:accent3><a:accent4><a:srgbClr val=""FFC000""/></a:accent4><a:accent5><a:srgbClr val=""4472C4""/></a:accent5><a:accent6><a:srgbClr val=""70AD47""/></a:accent6><a:hlink><a:srgbClr val=""0563C1""/></a:hlink><a:folHlink><a:srgbClr val=""954F72""/></a:folHlink></a:clrScheme><a:fontScheme name=""Office""><a:majorFont><a:latin typeface=""Calibri Light"" panose=""020F0302020204030204""/><a:ea typeface=""""/><a:cs typeface=""""/><a:font script=""Jpan"" typeface=""??????å? Light""/>" & _
"<a:font script=""Hang"" typeface=""?? ??""/><a:font script=""Hans"" typeface=""???? Light""/><a:font script=""Hant"" typeface=""?¼????w""/><a:font script=""Arab"" typeface=""Times New Roman""/><a:font script=""Hebr"" typeface=""Times New Roman""/><a:font script=""Thai"" typeface=""Tahoma""/><a:font script=""Ethi"" typeface=""Nyala""/><a:font script=""Beng"" typeface=""Vrinda""/><a:font script=""Gujr"" typeface=""Shruti""/><a:font script=""Khmr"" typeface=""MoolBoran""/><a:font script=""Knda"" typeface=""Tunga""/><a:font script=""Guru"" typeface=""Raavi""/><a:font script=""Cans"" typeface=""Euphemia""/><a:font script=""Cher"" typeface=""Plantagenet Cherokee""/><a:font script=""Yiii"" typeface=""Microsoft Yi Baiti""/><a:font script=""Tibt"" typeface=""Microsoft Himalaya""/><a:font script=""Thaa"" typeface=""MV Boli""/><a:font script=""Deva"" typeface=""Mangal""/><a:font script=""Telu"" typeface=""Gautami""/><a:font script=""Taml"" typeface=""Latha""/><a:font script=""Syrc"" typeface=""Estrangelo Edessa""/>" & _
"<a:font script=""Orya"" typeface=""Kalinga""/><a:font script=""Mlym"" typeface=""Kartika""/><a:font script=""Laoo"" typeface=""DokChampa""/><a:font script=""Sinh"" typeface=""Iskoola Pota""/><a:font script=""Mong"" typeface=""Mongolian Baiti""/><a:font script=""Viet"" typeface=""Times New Roman""/><a:font script=""Uigh"" typeface=""Microsoft Uighur""/><a:font script=""Geor"" typeface=""Sylfaen""/></a:majorFont><a:minorFont><a:latin typeface=""Calibri"" panose=""020F0502020204030204""/><a:ea typeface=""""/><a:cs typeface=""""/><a:font script=""Jpan"" typeface=""??????å?""/><a:font script=""Hang"" typeface=""?? ??""/><a:font script=""Hans"" typeface=""????""/><a:font script=""Hant"" typeface=""?¼????w""/><a:font script=""Arab"" typeface=""Arial""/><a:font script=""Hebr"" typeface=""Arial""/><a:font script=""Thai"" typeface=""Tahoma""/><a:font script=""Ethi"" typeface=""Nyala""/><a:font script=""Beng"" typeface=""Vrinda""/><a:font script=""Gujr"" typeface=""Shruti""/><a:font script=""Khmr"" typeface=""DaunPenh""/>" & _
"<a:font script=""Knda"" typeface=""Tunga""/><a:font script=""Guru"" typeface=""Raavi""/><a:font script=""Cans"" typeface=""Euphemia""/><a:font script=""Cher"" typeface=""Plantagenet Cherokee""/><a:font script=""Yiii"" typeface=""Microsoft Yi Baiti""/><a:font script=""Tibt"" typeface=""Microsoft Himalaya""/><a:font script=""Thaa"" typeface=""MV Boli""/><a:font script=""Deva"" typeface=""Mangal""/><a:font script=""Telu"" typeface=""Gautami""/><a:font script=""Taml"" typeface=""Latha""/><a:font script=""Syrc"" typeface=""Estrangelo Edessa""/><a:font script=""Orya"" typeface=""Kalinga""/><a:font script=""Mlym"" typeface=""Kartika""/><a:font script=""Laoo"" typeface=""DokChampa""/><a:font script=""Sinh"" typeface=""Iskoola Pota""/><a:font script=""Mong"" typeface=""Mongolian Baiti""/><a:font script=""Viet"" typeface=""Arial""/><a:font script=""Uigh"" typeface=""Microsoft Uighur""/><a:font script=""Geor"" typeface=""Sylfaen""/></a:minorFont></a:fontScheme>" & _
"<a:fmtScheme name=""Office""><a:fillStyleLst><a:solidFill><a:schemeClr val=""phClr""/></a:solidFill><a:gradFill rotWithShape=""1""><a:gsLst><a:gs pos=""0""><a:schemeClr val=""phClr""><a:lumMod val=""110000""/><a:satMod val=""105000""/><a:tint val=""67000""/></a:schemeClr></a:gs><a:gs pos=""50000""><a:schemeClr val=""phClr""><a:lumMod val=""105000""/><a:satMod val=""103000""/><a:tint val=""73000""/></a:schemeClr></a:gs><a:gs pos=""100000""><a:schemeClr val=""phClr""><a:lumMod val=""105000""/><a:satMod val=""109000""/><a:tint val=""81000""/></a:schemeClr></a:gs></a:gsLst><a:lin ang=""5400000"" scaled=""0""/></a:gradFill><a:gradFill rotWithShape=""1""><a:gsLst><a:gs pos=""0""><a:schemeClr val=""phClr""><a:satMod val=""103000""/><a:lumMod val=""102000""/><a:tint val=""94000""/></a:schemeClr></a:gs><a:gs pos=""50000""><a:schemeClr val=""phClr""><a:satMod val=""110000""/><a:lumMod val=""100000""/><a:shade val=""100000""/></a:schemeClr></a:gs>" & _
"<a:gs pos=""100000""><a:schemeClr val=""phClr""><a:lumMod val=""99000""/><a:satMod val=""120000""/><a:shade val=""78000""/></a:schemeClr></a:gs></a:gsLst><a:lin ang=""5400000"" scaled=""0""/></a:gradFill></a:fillStyleLst><a:lnStyleLst><a:ln w=""6350"" cap=""flat"" cmpd=""sng"" algn=""ctr""><a:solidFill><a:schemeClr val=""phClr""/></a:solidFill><a:prstDash val=""solid""/><a:miter lim=""800000""/></a:ln><a:ln w=""12700"" cap=""flat"" cmpd=""sng"" algn=""ctr""><a:solidFill><a:schemeClr val=""phClr""/></a:solidFill><a:prstDash val=""solid""/><a:miter lim=""800000""/></a:ln><a:ln w=""19050"" cap=""flat"" cmpd=""sng"" algn=""ctr""><a:solidFill><a:schemeClr val=""phClr""/></a:solidFill><a:prstDash val=""solid""/><a:miter lim=""800000""/></a:ln></a:lnStyleLst><a:effectStyleLst><a:effectStyle><a:effectLst/></a:effectStyle><a:effectStyle><a:effectLst/></a:effectStyle><a:effectStyle><a:effectLst>" & _
"<a:outerShdw blurRad=""57150"" dist=""19050"" dir=""5400000"" algn=""ctr"" rotWithShape=""0""><a:srgbClr val=""000000""><a:alpha val=""63000""/></a:srgbClr></a:outerShdw></a:effectLst></a:effectStyle></a:effectStyleLst><a:bgFillStyleLst><a:solidFill><a:schemeClr val=""phClr""/></a:solidFill><a:solidFill><a:schemeClr val=""phClr""><a:tint val=""95000""/><a:satMod val=""170000""/></a:schemeClr></a:solidFill><a:gradFill rotWithShape=""1""><a:gsLst><a:gs pos=""0""><a:schemeClr val=""phClr""><a:tint val=""93000""/><a:satMod val=""150000""/><a:shade val=""98000""/><a:lumMod val=""102000""/></a:schemeClr></a:gs><a:gs pos=""50000""><a:schemeClr val=""phClr""><a:tint val=""98000""/><a:satMod val=""130000""/><a:shade val=""90000""/><a:lumMod val=""103000""/></a:schemeClr></a:gs><a:gs pos=""100000""><a:schemeClr val=""phClr""><a:shade val=""63000""/><a:satMod val=""120000""/></a:schemeClr></a:gs></a:gsLst>" & _
"<a:lin ang=""5400000"" scaled=""0""/></a:gradFill></a:bgFillStyleLst></a:fmtScheme></a:themeElements><a:objectDefaults/><a:extraClrSchemeLst/><a:extLst><a:ext uri=""{05A4C25C-085E-4340-85A3-A5531E510DB2}""><thm15:themeFamily xmlns:thm15=""http://schemas.microsoft.com/office/thememl/2012/main"" name=""Office Theme"" id=""{62F939B6-93AF-4DB8-9C6B-D6C7DFDC589F}"" vid=""{4A3C46E8-61CC-4603-A589-7422A47A8E4A}""/></a:ext></a:extLst></a:theme>", _
False, True
MkDir strTmpZipPath & "\" & "xl" & "\" & "worksheets"
WriteToFile _
strTmpZipPath & "\" & "xl" & "\" & "worksheets" & "\" & "sheet1.xml", _
"<?xml version=""1.0"" encoding=""UTF-8"" standalone=""yes""?>" & _
"<worksheet xmlns=""http://schemas.openxmlformats.org/spreadsheetml/2006/main"" xmlns:r=""http://schemas.openxmlformats.org/officeDocument/2006/relationships"" xmlns:mc=""http://schemas.openxmlformats.org/markup-compatibility/2006"" mc:Ignorable=""x14ac"" xmlns:x14ac=""http://schemas.microsoft.com/office/spreadsheetml/2009/9/ac""><dimension ref=""A1""/><sheetViews><sheetView tabSelected=""1"" workbookViewId=""0""/></sheetViews><sheetFormatPr defaultRowHeight=""15"" x14ac:dyDescent=""0.25""/><sheetData/><pageMargins left=""0.7"" right=""0.7"" top=""0.75"" bottom=""0.75"" header=""0.3"" footer=""0.3""/></worksheet>", _
False, True
ZipAFolder strTmpZipPath, _
strLocalAppTmp & "\" & "EmptyExcelFile.zip"
moveFile strLocalAppTmp & "\" & "EmptyExcelFile.zip", strNewExcelFile
End Sub
'Dependancies NONE
'Version 1.0.0
'By jeremy.gerdes#navy.mil
Public Sub moveFile(strSourcePath, strDestinationPath)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
'Does the source file exist?
If FileExists(strSourcePath) Then
'If the destination is a folder then move the file into the folder preserving the source name
If FolderExists(strDestinationPath) Then
strDestinationPath = strDestinationPath & "\" & fso.GetFileName(strSourcePath)
End If
'If the destination allready exists, attempt to delete it... this move method allways over writes
If FileExists(strDestinationPath) Then
fso.DeleteFile strDestinationPath, True
End If
'If the destination path doesn't exist attempt to make it
If Not FolderExists(fso.GetParentFolderName(strDestinationPath)) Then
MkDir (fso.GetParentFolderName(strDestinationPath))
End If
'Move the file
fso.moveFile strSourcePath, strDestinationPath
End If
End Sub
Public Sub WriteToFile(ByRef strFileName, ByRef strContent, ByRef fOpenFile, ByRef fOverwrite)
Dim tf ' As Object
Dim FSO ' As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(strFileName) Then
If fOverwrite Then
FSO.DeleteFile strFileName
End If
End If
Set tf = FSO.OpenTextFile(strFileName, 8, True)
tf.WriteLine strContent
tf.Close
If fOpenFile Then
OpenWithExplorer strFileName
End If
'Clean up
Set tf = Nothing
Set FSO = Nothing
End Sub
Sub ZipAFolder (sFolder, zipFile)
'From /a/15143587/1146659
With CreateObject("Scripting.FileSystemObject")
zipFile = .GetAbsolutePathName(zipFile)
sFolder = .GetAbsolutePathName(sFolder)
With .CreateTextFile(zipFile, True)
.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, chr(0))
End With
End With
With CreateObject("Shell.Application")
.NameSpace(zipFile).CopyHere .NameSpace(sFolder).Items
Do Until .NameSpace(zipFile).Items.Count = _
.NameSpace(sFolder).Items.Count
WScript.Sleep 200
Loop
End With
End Sub
Public Sub OpenWithExplorer(ByRef strFilePath)
Dim wshShell
Set wshShell = CreateObject("WScript.Shell")
wshShell.Exec ("Explorer.exe " & strFilePath)
Set wshShell = Nothing
End Sub
Public Function Environ(ByRef strName)
'Replaces VBA.Envrion Public Function with wscript version for use in all VB engines
Dim wshShell: Set wshShell = CreateObject("WScript.Shell")
Dim strResult: strResult = wshShell.ExpandEnvironmentStrings("%" & strName & "%")
'wshShell.ExpandEnvironmentStrings behaves differently than VBA.Environ when no environment variable is found,
' conforming all results to return nothing if no result was found, like VBA.Environ
If strResult = "%" & strName & "%" Then
Environ = vbNullString
Else
Environ = strResult
End If
'cleanup
Set wshShell = Nothing
End Function
' Return true if file exists and false if file does not exist
Public Function FileExists(ByVal strPath) ' As String) As Boolean
Dim FSO 'As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
FileExists = FSO.FileExists(strPath)
' Clean up
Set FSO = Nothing
End Function
Public Function FolderExists(ByVal strPath) 'As String) As Boolean
Dim FSO ' As Object
' Note I used to use the vba.Dir Public Function but using that Public Function
' will lock the folder and prevent it from being deleted.
Set FSO = CreateObject("Scripting.FileSystemObject")
FolderExists = FSO.FolderExists(strPath)
' Clean up
Set FSO = Nothing
End Function
Function MkDir(strPath)
' Version: 1.0.3
' Dependancies: NONE
' Returns: True if no errors, i.e. folder path allready existed, or was able to be created without errors
' Usage Example: MkDir Environ("temp") & "\" & "opsRunner"
' Emulates linux 'MkDir -p' command: creates folders without complaining if it allready exists
' Superceeds the the VBA.MkDir function, but requires that drive be included in strPath
' By jeremy.gerdes#navy.mil
Dim fso ' As Scripting.FileSystemObject
Set fso = CreateObject("Scripting.FileSystemObject") ' New Scripting.FileSystemObject
If Not fso.FolderExists(strPath) Then
On Error Resume Next
Dim fRestore ' As Boolean
fRestore = False
'Handle Network Paths
If Left(strPath, 2) = "\\" Then
strPath = Right(strPath, Len(strPath) - 2)
fRestore = True
End If
Dim arryPaths 'As Variant
arryPaths = Split(strPath, "\")
'Restore Server file path prefix
If fRestore Then
arryPaths(0) = "\\" & arryPaths(0)
End If
Dim intDir ' As Integer
Dim strBuiltPath ' As String
For intDir = LBound(arryPaths) To UBound(arryPaths)
strBuiltPath = strBuiltPath & arryPaths(intDir) & "\"
If Not fso.FolderExists(strBuiltPath) Then
fso.CreateFolder strBuiltPath
End If
Next
End If
MkDir = (Err.Number = 0)
'cleanup
Set fso = Nothing
End Function
'Dependencies: NONE
'--- This function modified from: https://www.reddit.com/r/vba/comments/aom8xs/how_to_tell_if_script_is_running_in_vba_vbscript/ei0z2ll?utm_source=share&utm_medium=web2x&context=3
'--- Returns a string containing which script engine this is running in. Modified to test that wscript has a property 'Version' to allow for wscript emulation in the VBIDE
'--- Will return either "VBS","VBA", or "HTA".
Function ScriptEngine()
On Error Resume Next
ScriptEngine = "VBA"
Dim tmp
tmp = wscript.Version
If Err.Number = 0 Then
ScriptEngine = "VBS"
End If
Err.Clear
ReDim window(0)
If Err.Number = 501 Then
ScriptEngine = "HTA"
End If
On Error GoTo 0
End Function
'Dependencies: ScriptEngine
Function GetCurrentFileFolder()
Select Case ScriptEngine()
Case "VBS"
GetCurrentFileFolder = Left(wscript.ScriptFullName, Len(wscript.ScriptFullName) - Len(wscript.ScriptName) - 1)
Case "VBA"
Select Case Application.Name
Case "Microsoft Word"
GetCurrentFileFolder = ThisDocument.Path
Case "Microsoft Access"
GetCurrentFileFolder = CurrentProject.Path
Case "Microsoft Excel"
GetCurrentFileFolder = ThisWorkbook.Path
End Select
'Not going to bother checking for other VBA contexts like powerpoint, visio, ms project or autocad.
Case "HTA"
'----------------------------------------------------------------------
' - There are several methods to get the current directory of the HTA -
'----------------------------------------------------------------------
'From testing don't use the following
'This method drops the server path for network paths
'strPath = Left(Document.Location.pathname, InStrRev(Document.Location.pathname, "\") - 1) & "\Main.hta"
'This method works fine if the HTA directly executed,
'but if explorer.exe or cscript.exe executes the hta this method returns the %windir% dictory
'Dim objScripShell
'Set objScripShell = CreateObject("WScript.Shell")
'strPath = objScripShell.CurrentDirectory & "\Main.hta"
Dim strPath
strPath = jsUrlDecode(Document.Location.href)
strPath = Replace(strPath, "/", "\")
strPath = Left(strPath, InStrRev(strPath, "\") - 1)
'URLs that begin with a drive letter will begin with 'file:\\\' Check this first
If Left(strPath, 8) = "file:\\\" Then
strPath = Right(strPath, Len(strPath) - 8)
End If
'URLs that begin with a server name will begin with 'file:'
If Left(strPath, 5) = "file:" Then
strPath = Right(strPath, Len(strPath) - 5)
End If
GetCurrentFileFolder = strPath
End Select
End Function
'BuildEmptyExcelFile GetCurrentFileFolder & "\" & "anEmptyExcelFile.xlsx"
I agree with the comments above. I have always done this using Response.ContentType and Response.AppendHeader
Response.ContentType = "application/vnd.ms-excel"
Response.AppendHeader "content-disposition", "filename=MySpreadsheet.xls"
If Excel is installed and accessible on the server and sFSpec is the full (server mapped, accessible) file spec of the (empty) .xls you want to create, then
Dim oExcel : Set oExcel = [Server.]CreateObject( "Excel.Application" )
oExcel.Workbooks.Add.SaveAs sFSpec
oExcel.Quit
should work. If you can't use "Excel.Application", you may use ADO by opening a Excel connection and execute a suitable CREATE TABLE statement.
ADDED
The low tech approach would be to use an empty .xls stolen from some workstation as a template; but you can create an .xls on the fly:
Dim sFSpec : sFSpec = resolvePath("..\data\byado.xls")
If goFS.FileExists(sFSpec) Then goFS.DeleteFile sFSpec
Dim oXDb : Set oXDb = CreateObject("ADODB.Connection")
Dim sCS : sCS = Join(Array(_
"Provider=Microsoft.Jet.OLEDB.4.0" _
, "Data Source=" & sFSpec _
, "Extended Properties=""" _
& Join(Array( _
"Excel 8.0" _
, "HDR=Yes" _
, "IMEX=0" _
), ";" ) _
& """" _
), ";")
oXDb.Open sCS
oXDb.Execute "CREATE TABLE [WhatEver] (DontCare INTEGER)"
oXDb.Close
If goFS.FileExists(sFSpec) Then WScript.Echo "qed"
(You may have to tinker with the "Excel !Version!"; the "IMEX=0" is important)
I answered this on a another question.
correct formatting for excel spreadsheet
You should be able to use CreateObject("Excel.Application") on your server if office (at least Excel) is installed.
Xls (and the other types of Excel 2007/2010 are binary fiels that you can not easily create like that, you need to use Com objects to create and manipulate them. Here an example from the scripting guys http://blogs.technet.com/b/heyscriptingguy/archive/2005/01/31/how-can-i-make-changes-to-and-then-re-save-an-existing-excel-spreadsheet.aspx
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = FALSE
Set objWorkbook = objExcel.Workbooks.Add
Set objWorksheet = objWorkbook.Worksheets(1)
objWorksheet.Cells(1, 1).Value = Now
objWorkbook.SaveAs("C:\Scripts\Test.xls")
objExcel.Quit
see http://msdn.microsoft.com/en-us/library/aa223697(v=office.11).aspx for a list of vba functions you can use
I already try a search engine script like below:
<HTML><BODY>
<B>Search Results for <%=Request("SearchText")%></B><BR>
<%
Const fsoForReading = 1
Dim strSearchText
strSearchText = Request("SearchText")
''# Now, we want to search all of the files
Dim objFSO
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Dim objFolder
Set objFolder = objFSO.GetFolder(Server.MapPath("/"))
Dim objFile, objTextStream, strFileContents, bolFileFound
bolFileFound = False
For Each objFile in objFolder.Files
If Response.IsClientConnected then
Set objTextStream = objFSO.OpenTextFile(objFile.Path,fsoForReading)
strFileContents = objTextStream.ReadAll
If InStr(1,strFileContents,strSearchText,1) then
Response.Write "<LI><A HREF=""/" & objFile.Name & _
""">" & objFile.Name & "</A><BR>"
bolFileFound = True
End If
objTextStream.Close
End If
Next
if Not bolFileFound then Response.Write "No matches found..."
Set objTextStream = Nothing
Set objFolder = Nothing
Set objFSO = Nothing
%>
</BODY></HTML>
the output will show only the name of file, what i want is the title of the file.
my question is, how to get the string between in order to show up for the result? or is there any other script related to search engine in asp classic?
I'm not sure I get what you mean, but if you intend on grabbing the file name without the path nor extension, here's a snippet I use:
Public Function GetFileName(flname As String) As String
'From: http://www.freevbcode.com/ShowCode.asp?ID=1638
'By: Maria Rapini
'Get the filename without the path or extension.
'Input Values:
' flname - path and filename of file.
'Return Value:
' GetFileName - name of file without the extension.
Dim posn As Integer, i As Integer
Dim fName As String
posn = 0
'find the position of the last "\" character in filename
For i = 1 To Len(flname)
If (Mid(flname, i, 1) = "\") Then posn = i
Next i
'get filename without path
fName = Right(flname, Len(flname) - posn)
'get filename without extension
posn = InStr(fName, ".")
If posn <> 0 Then
fName = Left(fName, posn - 1)
End If
GetFileName = fName
End Function