Am I going mad? I cannot find a way to get hold of the first file in a folder with the FileSystemObject (classic ASP). With most collections you'd think the index 0 or 1 might work, but IIS says "Invalid procedure call or argument".
Neither of these last 2 lines work:
Set oFileScripting = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFileScripting.GetFolder(sFolder)
Set oFiles = oFolder.Files
If oFiles.Count = 0 Then Response.Write "no files"
Response.Write oFiles(0).Name
Response.Write oFiles.Item(1).Name
Am I being mega-stupid, or is there no way to use an index to access this particular collection?
The Files Collection is not an Array, and does not contain random-access functionality. If you absolutely need this functionality, the closest thing to imitate it would be to iterate through the folder and create a new Array containing the names of the files found, use this new array as the random-access source, and create File objects from the Array values.
ReDim FileArray(oFiles.Count)
i = 0
For Each oFile In oFiles
FileArray(i) = oFile.Name
i = i + 1
Next
Set oFile = oFileScripting.GetFile(sFolder + "\" + FileArray(0))
I certainly wouldn't recommend this if it is at all avoidable.
No, but you can enumerate them and track the index yourself:
Set oFileScripting = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFileScripting.GetFolder(sFolder)
Set oFiles = oFolder.Files
If oFiles.Count = 0 Then Response.Write "no files"
i = 0
For Each oFile In oFiles
Response.Write i & " = " & oFile.Name
i = i + 1
Next
Related
Have an assignment to do - it's to extract data from Lotus Notes DB including documents and their attachments. The purpose of this is to put it and store on the Sharepoint as a library.
So far I have managed to create a view and export the data for it to structure in Excel.
Also, I have looked up some Agents examples for extracting the attachments. With implementation of the below script, I managed to export the attachments:
Dim sDir As String
Dim s As NotesSession
Dim w As NotesUIWorkspace
Dim db As NotesDatabase
Dim dc As NotesDocumentCollection
Dim doc As NotesDocument
Sub Initialize
Set s = New NotesSession
Set w = New NotesUIWorkspace
Set db = s.CurrentDatabase
Set dc = db.UnprocessedDocuments
Set doc = dc.GetFirstDocument
Dim rtItem As NotesRichTextItem
Dim RTNames List As String
Dim DOCNames List As String
Dim itemCount As Integer
Dim sDefaultFolder As String
Dim x As Integer
Dim vtDir As Variant
Dim iCount As Integer
Dim j As Integer
Dim lngExportedCount As Long
Dim attachmentObject As Variant
x = MsgBox("This action will extract all attachments From the " & CStr(dc.Count) & _
" document(s) you have selected, And place them into the folder of your choice." & _
Chr(10) & Chr(10) & "Would you like To continue?", 32 + 4, "Export Attachments")
If x <> 6 Then Exit Sub
sDefaultFolder = s.GetEnvironmentString("LPP_ExportAttachments_DefaultFolder")
If sDefaultFolder = "" Then sDefaultFolder = "F:"
vtDir = w.SaveFileDialog( False, "Export attachments To which folder?", "All files|*.*", sDefaultFolder, "Choose Folder and Click Save")
If IsEmpty(vtDir) Then Exit Sub
sDir = StrLeftBack(vtDir(0), "\")
Call s.SetEnvironmentVar("LPP_ExportAttachments_DefaultFolder", sDir)
While Not (doc Is Nothing)
iCount = 0
itemCount = 0
lngExportedCount = 0
Erase RTNames
Erase DocNames
'Scan all items in document
ForAll i In doc.Items
If i.Type = RICHTEXT Then
Set rtItem = doc.GetfirstItem(i.Name)
If Not IsEmpty(rtItem.EmbeddedObjects) Then
RTNames(itemCount) = CStr(i.Name)
itemCount = itemCount +1
End If
End If
End ForAll
For j = 0 To itemCount-1
Set rtItem = Nothing
Set rtItem = doc.GetfirstItem(RTNames(j))
ForAll Obj In rtItem.EmbeddedObjects
If ( Obj.Type = EMBED_ATTACHMENT ) Then
Call ExportAttachment(Obj)
Call doc.Save( False, True )
'creates conflict doc if conflict exists
End If
End ForAll
Next
'Scan all items in document
ForAll i In doc.Items
If i.Type = ATTACHMENT Then
DOCNames(lngExportedCount) = i.Values(0)
lngExportedCount = lngExportedCount + 1
End If
End ForAll
For j% = 0 To lngExportedCount-1
Set attachmentObject = Nothing
Set attachmentObject = doc.GetAttachment(DOCNames(j%))
Call ExportAttachment(attachmentObject)
Call doc.Save( False, True )
'creates conflict doc if conflict exists
Next
Set doc = dc.GetNextDocument(doc)
Wend
MsgBox "Export Complete.", 16, "Finished"
End Sub
Sub ExportAttachment(o As Variant)
Dim sAttachmentName As String
Dim sNum As String
Dim sTemp As String
sAttachmentName = sDir & "\" & o.Source
While Not (Dir$(sAttachmentName, 0) = "")
sNum = Right(StrLeftBack(sAttachmentName, "."), 2)
If IsNumeric(sNum) Then
sTemp = StrLeftBack(sAttachmentName, ".")
sTemp = Left(sTemp, Len(sTemp) - 2)
sAttachmentName = sTemp & Format$(CInt(sNum) + 1, "##00") & _
"." & StrRightBack(sAttachmentName, ".")
Else
sAttachmentName = StrLeftBack(sAttachmentName, ".") & _
"01." & StrRightBack(sAttachmentName, ".")
End If
Wend
Print "Exporting " & sAttachmentName
'Save the file
Call o.ExtractFile( sAttachmentName )
End Sub
So the issue I do have right now is that these attachments are being saved to the same folder, which means that I would manually have to put them into right folders of library (several thousands). Could anyone help on how should I change the above code to have the attachments saved to separate folder for each document from DB?
Also for some reason that I cant find out below line is causing error pop up with "Object Variable not set":
sAttachmentName = sDir & "\" & o.Source
Would anyone know why it causes failure and stops the whole process?
You need to use the MkDir statement to create directory and extract attachments in the folder. Probably write something like:
MkDir sDir
You need to write code that create a new directory for each document (make sure you check if the directory exists, and preferably you make sure each directory has a unique name).
I wrote a tool like that, that exports all the fields of a document into XML, as well as attachments and embedded images. It can be set to separate each document into it's own directory.
You can read more about it ate the link below, perhaps you can get some ideas from the description. I use the UniversalID of teh document to get a unique folder name.
http://www.texasswede.com/websites/texasswede.nsf/Page/Notes%20XML%20Exporter
Im using the following code on an old IIS machine to generate XML for a mobile app I have built for android and ios devices... it works, but I am now wanting to figure out how I would go about SORTING by date last modified so the list has the NEWEST files at top... my question is, based on how I have my code structured below,
is this possible with my existing code ( sorting 'x' somehow? )?
<%#LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%Response.ContentType = "text/xml"%>
<%Response.AddHeader "Content-Type","text/xml"%>
<songlist>
<%
dim fs,fo,x
dim i
set fs=Server.CreateObject("Scripting.FileSystemObject")
'point to a specific folder on the server to get files listing from...
set fo=fs.GetFolder(Server.MapPath("./songs"))
i = -1
for each x in fo.files
'loop through all the files found, use var 'i' as a counter for each...
i = i + 1
'only get files where the extension is 'mp3' -- we only want the mp3 files to show in list...
if right(x,3) = "mp3" then
%>
<song>
<songid><%=i%></songid>
<name><%= replace(replace(x.Name, "-", " "), ".mp3", "")%></name>
<filename><%=x.Name%></filename>
<datemodified><%=x.DateLastModified%></datemodified>
</song>
<%
end if
next
set fo=nothing
set fs=nothing
%>
</songlist>
You can easily sort anything in VBScript using an old time trick known as Recordset Sorting. Code below is fully working and idea is taken from good old asp101 site, R.I.P (archive link)
<%#LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<% Option Explicit %>
<%Response.ContentType = "text/xml"%>
<%Response.AddHeader "Content-Type","text/xml"%>
<songlist>
<%
Const adVarChar = 200
Const adInteger = 3
Const adDate = 7
Dim objFSO, oFolder, oFile
Dim fileCounter, objRS
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
'point to a specific folder on the server to get files listing from...
Set oFolder = objFSO.GetFolder(Server.MapPath("."))
Set objFSO = Nothing
'create a disconnected recordset
Set objRS = Server.CreateObject("ADODB.Recordset")
'append proper fields
objRS.Fields.Append "Name", adVarChar, 255
objRS.Fields.Append "DateLastModified", adDate
objRS.Open
'loop through all the files found, add to the recordset
For Each oFile in oFolder.Files
objRS.AddNew
objRS.Fields("Name").Value = oFile.Name
objRS.Fields("DateLastModified").Value = oFile.DateLastModified
Next
Set oFolder=nothing
'sort and apply:
objRS.Sort = "DateLastModified DESC"
objRS.MoveFirst
fileCounter = 0
'loop through all the records:
Do Until objRS.EOF %>
<song>
<songid><%=fileCounter%></songid>
<filename><%=objRS("Name")%></filename>
<datemodified><%=objRS("DateLastModified")%></datemodified>
</song><%
fileCounter = fileCounter + 1
objRS.MoveNext()
Loop
objRS.Close
Set objRS = Nothing
%>
</songlist>
(I removed some bits when testing locally, you can of course add them back)
Worth to mention that Recordset sorting is very efficient, when I did custom benchmarks years ago it proved to work fast even with thousands of items.
Not without introducing alternative technologies for the sorting - the FileSystemObject.Files property doesn't support any sorting semantics.
A JScript solution seems like it could do an insertion sort fairly painlessly, though.
Trying to use a loop to check if images exists however it is always returning false. I am sure I am doing something simple and stupid but here is the code:
dim fs, sql_except
set fs=Server.CreateObject("Scripting.FileSystemObject")
if Not rs.eof then
arrRS = rs.GetRows(30,0)
set rs = nothing
If IsArray(arrRS) Then
For i = LBound(arrRS, 2) to UBound(arrRS, 2)
sku = arrRS(0, i)
if (fs.FileExists("../i/"&sku&".gif")=false) Then
response.write sku&"does not exist<br>"
end if
next
end if
erase arrRS
end if
set fs=nothing
You appear to be operating under the impression that the current folder context the your call to FileExists will assume is the physical folder containing the ASP script being executed. This is not so, it most likely will be "C:\windows\system32\inetsrv". You are also using URL path element separator / where FileExists is expecting windows physical path folder separator \.
You need to use Server.MapPath to resolve the path. This may work:
if Not fs.FileExists(Server.MapPath("../i/"&sku&".gif")) then
However you may run in to trouble with the parent path "..", this may not be allowed for security reasons. This might be a better approach:
Dim path : path = Server.MapPath("/parentFolder/i") & "\"
For i = LBound(arrRS, 2) to UBound(arrRS, 2)
sku = arrRS(0, i)
if Not fs.FileExists(path & sku & ".gif") Then
response.write Server.HTMLEncode(sku) & " does not exist<br>"
end if
next
Where "parentFolder" is the absolute path from the site root.
This is a method in ASP Classic that saves a file to disk. It takes a very long time but I'm not sure why. Normally, I wouldn't mind so much, but the files it handles are pretty large so need this needs to faster than 100kB a second save. Seriously slow. (old legacy system, band aid fix till it gets replaced...)
Public Sub SaveToDisk(sPath)
Dim oFS, oFile
Dim nIndex
If sPath = "" Or FileName = "" Then Exit Sub
If Mid(sPath, Len(sPath)) <> "\" Then sPath = sPath & "\" '"
Set oFS = Server.CreateObject("Scripting.FileSystemObject")
If Not oFS.FolderExists(sPath) Then Exit Sub
Set oFile = oFS.CreateTextFile(sPath & FileName, True)
For nIndex = 1 to LenB(FileData)
oFile.Write Chr(AscB(MidB(FileData,nIndex,1)))
Next
oFile.Close
End Sub
I'm asking because there are plenty of WTF's in this code so I'm fighting those fires while getting some help on these ones.
I don't see your definition for "FileData" anywhere in your code - where is this coming from? Is there a reason you're writing it to disk a single character at a time? I'd suspect this is your problem - writing 100K of data takes 100K trips through this loop, which could be the reason for your slowdown. Why can't you replace the write loop at the bottom:
For nIndex = 1 to LenB(FileData)
oFile.Write Chr(AscB(MidB(FileData,nIndex,1)))
Next
with a single statement to write the file all at once?
oFile.Write FileData
What you should do is read the binary request into an ADODB.Stream object and convert it to plain ASCII text in a single fast step.
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = 1
objStream.Open
objStream.Write Request.BinaryRead(Request.TotalBytes)
objStream.Position = 0
objStream.Type = 2
objStream.Charset = "ISO-8859-1"
FormData = objStream.ReadText
objStream.Close
Set objStream = Nothing
Notice how the variable FormData now contains the form data as text. Then you parse this text and locate the start and length of each file, and use ADODB.Stream CopyTo method to extract the specific portion of the file and save it do disk.
Is there an equivalent to PHP's get_included_files in classic ASP?
No, there is not.
A very ugly function for that:
<!--#include file="include/common.asp"-->
<%
Function GetIncludedFiles()
Dim Url
Dim Fso
Dim Fs
Dim Src
Dim Arr
Dim Ret
Dim i
Set Fso = Server.CreateObject("Scripting.FileSystemObject")
ReDim Ret(-1)
Url = Request.ServerVariables("URL")
Set Fs = Fso.OpenTextFile(Server.MapPath(Url))
Src = Fs.Readall()
Fs.Close
Set Fs = Nothing
Set Fso = Nothing
Arr = Split(Src, "<" & "!--#include file=")
For i = 0 To UBound(Arr)
Arr(i) = Left(Arr(i), InStr(Arr(i), "-->"))
Arr(i) = Replace(Arr(i), "-", "")
Arr(i) = Replace(Arr(i), "'", "")
Arr(i) = Trim(Replace(Arr(i), """", ""))
If Arr(i) <> "" Then
ReDim Preserve Ret(UBound(Ret) + 1)
Ret(UBound(Ret)) = Arr(i)
End If
Next
GetIncludedFiles = Ret
End Function
Dim File
For Each File In GetIncludedFiles()
Response.Write File & "<br />"
Next
%>
The simple way is to create a main file in a specific directory (for example /include/mainfile.asp) and then include all the other files to this file. Something like:
<!#include File="[your directory here/file1.asp]"-->
<!#include File="[your directory here/file2.asp]"-->
<!#include File="[your directory here/file3.asp]"-->
Then, You can include your main file using "virtual" to the rest of your pages that you want to access those other included files.
<!#include Virtual="/include/mainfile.asp"-->
Not as such, but I vaguely remember seen a tool or two floating around that will give you the equivalent report. It might have been on Code Project or somewhere similar... its been a long time since I last ran across it.