I'm tying to make something in VBA that will basically list all the files in one or more directories starting from a root folder. Long story short, I'm using filesystemobject to run through all of the folders and then getting all the files in those folders. Moving to the next folder, etc.
The problem I'm running into is that I need to spit out my data (onto a sheet) in the same folder sort order as one might find in Windows. I know this isn't a fixed concept per say, so here's a quick example, as it's displayed in Windows(for me):
Windows Sort Order:
FolderTest\000
FolderTest\0
FolderTest\0001
Not too surprisingly, when using FSO it returns the sub folders in a different (perhaps more logical) order:
FolderTest\0
FolderTest\000
FolderTest\0001
I was hoping someone might have an idea of what one could do to get this to be resorted as it's displaying in Windows. This is just an example obviously, the files could be named anything, but it certainly seems to behave a lot better with alpha characters in the name. I'm not necessarily married to using FSO, but I don't even know where else to look for an alternative. I know I could potentially resort these in an array, but I'm not sure what kind of wizardry would be required to make it sort in the "proper" order. For all I know, there's some method or something that makes this all better. Thanks in advance for any help!
To whoever it may end up helping, the following code looks like it's giving me the results I was looking for, converting a list of subfolders into the same sort orders you (probably) find in Windows Explorer. Feeding in Subfolders from a Filesystem object, it spits the results out in an array (fnames). The code... it's not pretty. I'll be the first to admit it. Don't judge me too harshly. Big thanks #Paddy (see above) for pointing me towards StrCmpLogicalW (http://msdn.microsoft.com/en-us/library/windows/desktop/bb759947(v=vs.85).aspx)
Private Declare PtrSafe Function StrCmpLogicalW Lib "shlwapi" _
(ByVal s1 As String, ByVal s2 As String) As Integer
Sub filefoldersortWindows()
Dim folder As String
Dim fnames() As String, buffer As String, content As String
folder = "Your Path"
Set fsol = CreateObject("Scripting.fileSystemObject")
Set fold = fsol.GetFolder(folder)
FoldCount = fold.SubFolders.Count
ReDim fnames(FoldCount)
cFcount = 0
For Each fld In fold.SubFolders
cFcount = cFcount + 1
Namer$ = fld.Name
fnames(cFcount) = StrConv(Namer, vbUnicode)
Next
For AName = 1 To FoldCount
For BName = (AName + 1) To FoldCount
If StrCmpLogicalW(fnames(AName), fnames(BName)) = 1 Then
buffer = fnames(BName)
fnames(BName) = fnames(AName)
fnames(AName) = buffer
End If
Next
Next
For i = 1 To FoldCount
fnames(i) = StrConv(fnames(i), vbFromUnicode)
If i > 1 Then
content = content & "," & fnames(i)
Else
content = fnames(i)
End If
Next
End Sub
Ahh, I see now. I made a bunch of directories with numeric names to see what's going on. Windows explorer does an integer conversion on the value. The sort rule is like this:
numeric value : ascending
padding length : descending
So, if have 01 and 001, both evaluate to the integer 1, but 001 will appear first because it is longer (has more zero-padding). The 'length' in this case only refers to the numeric part (ie the padding), and is not affected by any characters that appear after (they only matter if the numeric value and the padding length are the same - then normal ordering applies):
Related
I want to write a VBScript, which outputs the position of a CAD part (x,y,z). The Input should be the partnumber. This is what I tried.
Sub CATMain()
dim pos(11)
for n = 1 to CATIA.Documents.Count
set Dokument = CATIA.Documents.Item(n)
for i = 1 to Dokument.product.products.Count
set InstDokument = Dokument.product.products.item(i)
If InstDokument = "my_part" Then
msgbox InstDokument.Name
InstDokument.Position.GetComponents pos
msgbox "Origin Point: X= " &pos(9) &" Y= " &pos(10) &" Z= " &pos(11)
End If
next
next
End Sub
I got an error in line 8 column 2. The object does not have the property or method.: Dokument.product
How can I solve that?
There are several problems with your code.
At the root is probably this:
set Dokument = CATIA.Documents.Item(n)
The CATIA documents collection will contain many documents which do not have windows and which the CATIA application maintains for it's own various internal purposes. So it is not assured that CATIA.Documents.Item(n) actually contains a CATProduct.
In most cases one is interested in the current active document, and it is retrieved like this:
Set Dokument = CATIA.ActiveDocument
Otherwise you can test for it
Set Dokument = CATIA.Documents.Item(n)
if typename(Dokument) = "ProductDocument" Then ...
Even after that you have problems. You are comparing the Document object to a string... and other things. Also without recursion you may never find your target instance if it is deeper then at the first level. It may also be possible that search may be a better way to find your instance then "Reading the tree".
Once you have corrected all your infrastructure errors your method for getting the transformation matrix is basically correct.
I have the following VBA code:
Sub test2()
Dim w1 As Worksheet
Dim w2 As Worksheet
Dim k As Long
Dim c As Range
Dim d As Range
Dim strFA As String
Set w1 = Sheets("Sheet1")
Set w2 = Sheets("Sheet2")
w2.Cells.Clear
k = 1
With w1.Range("A:A")
Set c = .Cells.Find("FirstThing", After:=.Cells(.Cells.Count), lookat:=xlWhole)
strFA = ""
While Not c Is Nothing And strFA <> c.Address
If strFA = "" Then strFA = c.Address
If IsError(Application.Match(c.Offset(0, 1).value, w2.Range("A:A"), False)) Then
Set d = .Cells.Find("SecondThing", c, , xlWhole)
w2.Range("A" & k).value = c.Offset(1, 0).value
w2.Range("B" & k).value = d.Offset(0, 1).value
k = k + 1
End If
Set c = .Cells.Find("FirstThing", After:=c, lookat:=xlWhole)
Wend
End With
End Sub
The code works essentially like this:
Look through Sheet1 for a certain phrase.
Once the phrase is found, place the value from the cell one row over in Sheet2
Search for a second phrase.
Place the value from the cell one row over in the cell beside the other value in Sheet2
Repeat
Now. I have the same data that, don't ask me why, is in .doc files. I'd like to create something similar to this code that will go through and look for the first phrase, and place the next n characters in an Excel sheet, and then look for the second phrase and place the next m characters in the row beside the cell housing the previous n characters.
I'm not sure whether it's better to do this with a bash script or whether it's possible to do this with VBA, so I've attached both as tags.
Your question seems to be: "I'm not sure whether it's better to do this with a bash script or whether it's possible to do this with VBA"
The answer to that is: You'd need VBA, especially since this is a *.doc file - docx would be a different matter.
In order to figure out what that is, start by trying to do the task manually in Word. More specifically, how to use Word's "Find" functionality. When you get that figured out, record those actions in a macro to get the starting point for your syntax. The code on the Excel side for writing the data across will essentially stay the same.
You'll also need to decide where the code should reside: in Word or in Excel. That will mean researching how to run the other application from within the one you choose - lots of examples here on SO and on the Internet...
Here's part of my code.
<%
Dim lineData,fso,filea,fileb,filec
s=request.querystring("query")
set fso = Server.CreateObject("Scripting.FileSystemObject")
a(0,0)=0
a(1,0)=" - Entries in File A"
set filea = fso.OpenTextFile(Server.MapPath("FileA.txt"), 1, true)
do until lone.AtEndOfStream
lineData = lcase(filea.ReadLine())
if instr(lineData,s)>0 then
a(0,0)=a(0,0)+1
end if
Loop
a(0,1)=0
a(1,1)=" - Entries in File B"
set fileb = fso.OpenTextFile(Server.MapPath("FileB.txt"), 1, true)
do until mile.AtEndOfStream
lineData = lcase(fileb.ReadLine())
if instr(lineData,s)>0 then
a(0,1)=a(0,1)+1
end if
Loop
a(0,2)=0
a(1,2)=" - Entries in File C"
set filec = fso.OpenTextFile(Server.MapPath("FileC.txt"), 1, true)
do until payne.AtEndOfStream
lineData = lcase(filec.ReadLine())
if instr(lineData,s)>0 then
a(0,2)=a(0,2)+1
end if
Loop
%>
The code essentially looks for the number of entries in a text file. What I need is it to be sorted such that the file with the most number of entries comes first.
Suppose there are 10 entries in FileA, 12 in FileB and 7 in FileC. I'd like the output to be displayed like this:
12 - Entries in File B
10 - Entries in File A
7 - Entries in File C
I'm guessing it won't be too complicated since response.write(a(0,i)&a(1,i)) will work. I just need help with the loop or any sorting method if there is one.
Any help I can get in here will be much appreciated.
This will be a "neo-answer" that should help you get to where you want to go, both in the short- and long-term.
1) First, a suggestion for further reading to help you address this sort of problem in a more general way -- and to help you develop your "chops" as you go. You can Google the term "bubble sort" and get a whole host of interesting and mostly helpful input, but here's a link you probably will find most directly helpful, from a brief series of articles on sorting from the 4 Guys from Rolla site, which back in the day was THE place for quality writing on ASP:
https://web.archive.org/web/20211020153403/https://www.4guysfromrolla.com/webtech/011601-1.shtml
You will see that there is a link to an introductory article at the top of this one that covers one-dimensional array sorting, and I recommend it as well. For one, it introduces another sort method, QuickSort, and having multiple tools in your toolbox is almost never a bad idea. (As you will discover, bubble sorting is often the easiest to envision and implement, but because its performance is essentially linear based on the number of items being sorted, can become a performance problem on larger datasets.) Go ahead, check it out; I'll wait 'til you get back...
2) OK, to give you a more concrete approach to address your specific situation here, if the number of files you're reviewing isn't going to be too large, you can do a sort of "final pass" sort to present your results in the desired order.
First, you'll want to introduce a simple global counting variable up toward the top of your code:
dim intMaxEntries
intMaxEntries = 0
Then, at the end of each of your file-parsing runs, you'll want to check the number of entries against intMaxEntries and update intMaxEntries if the number of entries just read in is greater.
if a(0, 1) > intMaxEntries then
intMaxEntries = a(0, 1)
end if
You'll do right after each file reading loop, so the comparison in the above snippet would be done for a(0, 1), a(1, 1), and a(2, 1). More on that repetitive logic at the end.
After you've done all the file reads, intMaxEntries will have the maximum number of entries you've found in one of the files. Then, you can just step down from that value and print out entry counts in the correct order when they match your countdown:
dim i, j
for i = intMaxEntries to 0 step -1
for j = 0 to ubound(a) 'By default gives the upper bound of the 1st dimen.
if a(j, 1) = i then
Response.Write i & a(j, 2) & "<BR>"
end if
next j
next i
This is more than a bit of a hack, and I would encourage you to opt instead for doing a proper sort of your array so that you have something more generalizably useful, but it will work to get you where you want to go, especially if the number of files -- or the maximum number of entries -- isn't too large. You could also clean up my example by introducing the possibility of breaking out of the loops when all the files are accounted for, but I'll let you figure out if that's necessary.
3) You may have just simplified the codebase to get the concept across more cleanly (for which I applaud you if true), but just in case, I would encourage you to look at ways to modularize your work by building your file reading functionality as a function that is simply called with the file and string comparison information needed. (Also, probably an artifact of your snipping, but the "lone", "mile" and "Payne" references in there don't make sense; assuming those are the FSOs you are instantiating and have just forgotten to change them to fileA, fileB and fileC.)
Hope that helps a bit,
Bret
#bret
Someone else came through.
Here's a code that worked perfectly.
Would this be an example of "bubble sort"?
for k=23 to 0 Step-1
for j=0 to k
if (a(0,j)<a(0,j+1)) then
t1=a(0,j+1)
t2=a(1,j+1)
a(0,j+1)=a(0,j)
a(1,j+1)=a(1,j)
a(0,j)=t1
a(1,j)=t2
end If
next
next
for i=0 to 24
if a(0,i)>0 then
response.write (a(0,i)&a(1,i)&"<br>")
end if
next
set objFSO = Server.CreateObject("Scripting.FileSystemObject")
set objFolder = objFSO.GetFolder(server.mappath("Files"))
set objfiles = objFolder.Files
Function filesearch(name)
set searchname = objFSO.OpenTextFile(server.mappath(filename),1, true)
do until searchname.AtEndOfStream
lineData = lcase(searchname.ReadLine())
if instr(lineData,s)>0 then
instances = instances + 1
end if
Loop
End Function
For Each objFile in objFolder.Files
filesearch(objFile)
Response.Write filename & "<br>" & instances & "<br>" & "<br>"
Next
Set objFolder = Nothing
Set objFSO = Nothing
There are a few rough edges but what really bothers me now is the sorting. Where do I keep the bubble sort code?
EDIT:
I've got it work perfect with the following code.
For Each objFile in objFolder.Files
filesearch(objFile)
i = i + 1
a(0,i) = instances
a(1,i) = filename
Next
I was also wondering if there's anyway I could also write the total number of instances. I was able to do it before with:
for i=0 to 43
entries=entries+a(0,i)
next
I cant seem to make it work now.
EDIT:
Works now with:
for i = 0 to n
entries = entries + a(0,i)
next
So, I've looked around and tried to solve this on my own. This isn't an absolutely crucial question currently, I just want to know if it could be done.
So let's say I've got a list with some data that looks like
Date Location
01/24/14 H-12
01/25/14 BB-44
01/30/14 G-12
01/29/14 7A-55
01/28/14 NN-15
01/24/14 GG-47
What I want is to be able to sort the data by Location, but I don't want it to be the general way, otherwise I'll end up with 7A-55, BB-44, G-12, H-12, NN-15. I want the data to be sorted so that double letters and single letters are sorted together. E.G. it should be G-12, H-12, BB-44, NN-15, 7A-55 once everything has been sorted.
I've tried creating a custom list sort, but it doesn't work. the way intended. The custom list I tried was A-Z, AA-ZZ, 7A (items were listed out, but for saving space I wrote them like that).
Like I said, this isn't a particularly huge deal if it can't be done, it just would have made it a little easier.
Edit 1 Here is what I would like to be the output
Date Location
01/30/12 G-12
01/24/14 H-12
01/25/14 BB-44
01/24/14 GG-47
01/28/14 NN-15
01/29/14 7A-55
Edit
All of these worked in the regards i wanted to, although if I had to choose a favorite it would be the base 36 number conversion one. That was some real out-of-the-box thinking and the math geek in me appreciated it. Thanks everyone!
Well it works, but is a bit complex, so rather just for fun:
This UDF returns a value that can be used as sort key. It transforms the code into a four-digit base 36-number, i.e. using A-Z and 0-9 as symbols (like hex uses 0-9 and A-F). To get at your desired output, I literally put the symbols in this order, letters first (so "A" = 0 and "0" = 26).
(The missing 'digits' are filled up with zeros, which are in this case "A"s)
It works ;)
Public Function Base36Transform(r As Range) As Long
Dim s As String, c As String
Dim v
Dim i As Integer
Dim rv As Long
v = Split(r.Text, "-")
s1 = v(0)
s2 = v(1)
s = Right("A" & s1, 2) & Right("A" & s2, 2)
rv = 0
For i = 1 To Len(s)
c = Mid(s, Len(s) - i + 1, 1)
If c Like "#" Then
rv = rv + (Val(c) + 26) * (36 ^ (i - 1))
Else
' c is like "[A-Z]"
rv = rv + (Asc(c) - Asc("A")) * (36 ^ (i - 1))
End If
Next
Base36Transform = rv
End Function
Sorting is often a very creative process. VBA can ease up the process, but a little extension of the data will work just as well.
See my results:
The way I did it is by getting the length of each string, just to be safe. This is gotten by simply going =LEN(B2), dragged down.
Then I check if it starts with 7. If it does, assign 1, otherwise keep at 0. I used this formula: =(LEFT(B2,1)="7")*1, dragged down.
Now, my custom sort is this:
Now I might have gotten some things wrong here, or I might even have done overkill by going the Length column. However, the logic is pretty much what you're aiming for.
Hope this helps in a way! Let us know. :)
I am a little lazy here and assuming your data sits in Column A,B. You mightneed to adjust your range or the starting point of your list. But here's the code:
Sub sortttttt()
Dim rng As Range
Dim i As Integer
Range("B2").Activate
Do While Not IsEmpty(ActiveCell)
ActiveCell.Value = Len(ActiveCell.Value) & ActiveCell.Value
ActiveCell.Offset(1, 0).Activate
Loop
Set rng = Range("A1:B6")
rng.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlYes
Range("B2").Activate
Do While Not IsEmpty(ActiveCell)
ActiveCell.Value = Right(ActiveCell.Value, Len(ActiveCell.Value) - 1)
ActiveCell.Offset(1, 0).Activate
Loop
End Sub
Assuming your data is in columns B:C with labels in Row1 and no intervening blank rows, add a column with:
=IF(ISNUMBER(VALUE(LEFT(C2))),3,IF(FIND("-",C2)>2,2,1))
in D1 copied down to suit and sort ascending Location within sort ascending of the added column.
I'm trying to manage a quite-small DataBase with Vb6 and NotePad.
I collect all the record in Random into the Notepad File (.dat).
I use the Get and Put command for getting the record I stored and insert the newest.
Now I'd like to have the possibility to DELETE a record I entered (maybe the latest).
I tought that:
Delete #FileNumber1, LatestRec, MyRec
was a good chance to get it.
LatestRec is the number of the latest record (ex: 5 means the 5th).
MyRec is my record variable.
Any suggestions?
The Delete statement you note above doesn't apply for random access files. Unfortunately, VB6 Random Access files provide no direct mechanism for record deletion, primarily because deletion leads to a rat's nest of other issues, such as file contraction (filling the empty space), fragmentation (unused empty space), to name a couple. If you truly need to delete a record, about the only option you have is to copy all the other records to a temporary file, delete the old file, and rename the temp file to the "original" name - and, sadly, that's right from Microsoft.
One thing you can do, which I'll admit up front isn't ideal, is to add a "deleted" field to your random-access file, defaulting to 0, but changing to true, 1, or some other relevant value, to indicate that the record is no longer valid.
You could even get into writing routines to reuse deleted records, but if you're getting into file semantics that much, you might be better served by considering a move of the application to a more robust database environment, such as SQL Server.
*EDIT:*Here is a very rough/crude/untested chunk of sample VB6 code that shows how you would delete/add a record with the "deleted field" concept I described above..caveat that tweaks might be needed to get this code perfect, but the point is to illustrate the concept for you:
Type SampleRecord
UserID As Long
lastName As String * 25
firstName As String * 25
Deleted As Boolean
End Type
' This logically deletes a record by setting
' its "Deleted" member to True
Sub DeleteRecord(recordId As Long)
Dim targetRecord As SampleRecord
Dim fileNumber As Integer
fileNumber = FreeFile
Open "SampleFile" For Random As fileNumber Len = LenB(SampleRecord)
Get fileNumber, recordId, targetRecord
targetRecord.Deleted = True
Put #fileNumber, recordId, targetRecord
Close #fileNumber
End Sub
Sub AddRecord(lastName As String, firstName As String)
Dim newRecord As SampleRecord
Dim fileNumber As Integer
Dim newRecordPosition As Long
newRecord.firstName = firstName
newRecord.lastName = lastName
newRecord.Deleted = False
newRecord.UserID = 123 ' assume an algorithm for assigning this value
fileNumber = FreeFile
Open "SampleFile" For Random As fileNumber Len = LenB(SampleRecord)
newRecordPosition = LOF(fileNumber) / LenB(SampleRecord) + 1
Put #fileNumber, newRecordPosition, newRecord
Close #fileNumber
End Sub