I need to reverse this loop:
I've tried using "Step -1", but has not worked.
I guess it's because that's a FSO method of loop.
Set d = fso.GetFolder("address")
For Each File In d.files
If (Int(Mid(File.Name, 30, 5)) = Int(nfprocurada)) Then
ActiveWorkbook.FollowHyperlink Address:=File.Path, ExtraInfo:=False
Exit Sub
End If
Next
For Each loops don't accept any change in Step size or sign. So if you want to reverse the direction, you'll need to change looping types to an index based loop like For counter = start to end. Since a Files collection doesn't accept an index as an arguement, you'll need to copy each file to an array before you are able to loop through the files with an index.
Try this:
Set d = FSO.getfolder("address")
Dim AllFiles() As Object, FileCount As Integer
For Each File In d.Files
ReDim Preserve AllFiles(FileCount)
Set AllFiles(UBound(AllFiles)) = File
FileCount = FileCount + 1
Next File
Dim i as Long
For i = UBound(AllFiles) To LBound(AllFiles) Step -1
If (Int(Mid(File.Name, 30, 5)) = Int(nfprocurada)) Then
ActiveWorkbook.FollowHyperlink Address:=AllFiles(i).Path, ExtraInfo:=False
Exit Sub
End If
Next i
Related
I have a Streamreader which is trowing an error after checking every line in Daycounts.txt. It is not a stable txt file. String lines in it are not stable. Count of lines increasing or decresing constantly. Thats why I am using a range 0 to 167. But
Here is the content of Daycounts.txt: Daycounts
Dim HourSum as integer
Private Sub Change()
Dim R As IO.StreamReader
R = New IO.StreamReader("Daycounts.txt")
Dim sum As Integer = 0
For p = 0 To 167
Dim a As String = R.ReadLine
If a.Substring(0, 2) <> "G." Then
sum += a.Substring(a.Length - 2, 2)
Else
End If
Next
HourSum = sum
R.Close()
End Sub
If you don't know how many lines are present in your text file then you could use the method File.ReadAllLines to load all lines in memory and then apply your logic
Dim HourSum As Integer
Private Sub Change()
Dim lines = File.ReadAllLines("Daycounts.txt")
Dim sum As Integer = 0
For Each line In lines
If line.Substring(0, 2) <> "G." Then
sum += Convert.ToInt32(line.Substring(line.Length - 2, 2))
Else
....
End If
Next
HourSum = sum
End Sub
This is somewhat inefficient because you loop over the lines two times (one to read them in, and one to apply your logic) but with a small set of lines this should be not a big problem
However, you could also use File.ReadLines that start the enumeration of your lines without loading them all in memory. According to this question, ReadLines locks writes your file until the end of your read loop, so, perhaps this could be a better option for you only if you don't have something external to your code writing concurrently to the file.
Dim HourSum As Integer
Private Sub Change()
Dim sum As Integer = 0
For Each line In File.ReadLines("Daycounts.txt")
If line.Substring(0, 2) <> "G." Then
sum += Convert.ToInt32(line.Substring(line.Length - 2, 2))
Else
....
End If
Next
HourSum = sum
End Sub
By the way, notice that I have added a conversion to an integer against the loaded line. In your code, the sum operation is applied directly on the string. This could work only if you have Option Strict set to Off for your project. This setting is a very bad practice maintained for VB6 compatibility and should be changed to Option Strict On for new VB.NET projects
I need help in a VBA macro that'll delete files in a directory that contains more than 2 "_" and is older than 3 months old, however there are some folders & sub folders in the directory that must not be touched or modified.
E.g, Hi_Thanks_for_your_help or Hi_Thank_You etc.
Const DIR = "x"
Const MAX_AGE = 3 ' Unit: Months
Dim oFSO
Dim aExclude
Sub XLS()
aExclude = Array("x")
Set oFSO = CreateObject("Scripting.FilesystemObject")
deleteFiles oFSO.GetFolder(DIR)
Set oFSO = Nothing
End Sub
'=================================
Function isExclude(sPath)
Dim s, bAns
bAns = False
For Each s In aExclude
If InStr(1, sPath, s, vbTextCompare) = 1 Then
bAns = True
Exit For
End If
Next
isExclude = bAns
End Function
'=================================
Function isOldFile(fFile)
' Old file if "MAX_AGE" months before today is greater than the file modification time
isOldFile = (DateAdd("m", -MAX_AGE, Date) > fFile.DateLastModified)
End Function
This is the furthest i got with a code, what i'm lacking is how to check if a file name consists more than 2 "_" and if so & it's older than 3 months old = delete.
Thanks in advance! Cheers!
Dim pathname As String = ""
If fileNameCount("file_name") And DateDiff("m", NOW(), FileDateTime(pathname)) > 3 Then ' if '_' is more than 2 count and more than 3 months old, then delete
' if true delete file codes starts here
......
End If
Public Function fileNameCount(filename As String) As Boolean
fileNameCount = False
Dim count As Long
Dim temp() As String
temp = Split(filename, "_")
count = UBound(temp, 1)
If (count > 2) Then
fileNameCount = True
End If
End Function
I have written portion of the codes for you, the method fileNameCount will return you true / false for number of counts of '_', I'm using DateDiff to get the difference of the month of the file. Therefore I'm detecting on the both conditions, if both statement are true condition then you should proceed on with your deletion of file codes which I didn't write for that.
What you need to do is
1) Pass in the "file_name" argument which you need to think on how to get the file name
2) Pass in the right pathname of the file
3) Write the code for deletion of files
Anyway, I didn't test out the code so it might have some error(s). Hope this will help what you're trying to do.
To get the amount of "_" in a file, I would use something similar to this:
Dim a
Dim c As Integer
a = Split("File_Name_Here", "_")
c = Ubound(a)
Using this, you know that if the filename gets split into 3 or more substrings, there were 2 "_" in the filename. As for the age of the file, FileDateTime("FilePath") will get you the created date or the last modified date.
I have a folder with lots of text files each containing (but in random order) :
A = ...
B = ...
C = ...
Now I would like to import these text files into an excel-spreadsheet,
where each of the prefixes is organized in the colums, and the files are listed as rows
Example: 2 files
File 1:
A = 1
B = 2
C = 3
File 2:
A = 4
B = 5
C = 6
I would the excel to look like :
NR / A / B / C
1 / 1 /2 /3
2 / 4/ 5 /6
I am still learning VB, and this is just a bit over the top for me.
I have found a macro like this:
Sub Read_Text_Files()
Dim sPath As String, sLine As String
Dim oPath As Object, oFile As Object, oFSO As Object
Dim r As Long
'Files location
sPath = "C:\Test\"
r = 1
Set oFSO = CreateObject( _
"Scripting.FileSystemObject")
Set oPath = oFSO.GetFolder(sPath)
Application.ScreenUpdating = False
For Each oFile In oPath.Files
If LCase(Right(oFile.Name, 4)) = ".txt" Then
Open oFile For Input As #1 ' Open file for input.
Do While Not EOF(1) ' Loop until end of file.
Input #1, sLine ' Read data
If Left(sLine, 1) = "A=" Then 'Now i need to write this to the first column of that row
If Left(sLine, 1) = "B=" Then 'For the second column.
Range("A" & r).Formula = sLine ' Write data line
r = r + 1
Loop
Close #1 ' Close file.
End If
Next oFile
Application.ScreenUpdating = True
End Sub
Do you know how to open files in VBA for reading using syntax like Open and Line Input?
If not, read this: https://stackoverflow.com/a/11528932/2832561
I found this by googling for "VBA open file read"
Do you know how to work with and parse strings (and arrays) using functions like Mid, Left, Right, Split and Join?
If not, try reading this: http://www.exceltrick.com/formulas_macros/vba-split-function/
I found this by googling for "VBA String functions parse text"
Do you know how to work with Workbook and Worksheet objects and assign values to Range objects in Excel?
If not, try reading this: http://www.anthony-vba.kefra.com/vba/vbabasic2.htm
I found this by googling for "Workbook Worksheet Range VBA"
Once you have had a chance to try putting together a solution using these pieces, you can post specific questions on any issues you run into.
I have a text file with questions, one per line. I want powerpoint to randomly select a line from the file and put that line into a label. I would also like to make sure that each line would only be used once. If there is no easy way of going about this, maybe a way to delete the line that was selected from the text file. I found some code online but it won't do what I want (not using the same line twice).
Try this
Sub do_file()
Dim myArray
Open [YOUR TEXT FILE HERE] For Input As #1
fileinfo = Input(LOF(1), #1)
Close #1
myArray = Split(fileinfo, vbCrLf)
myArray = ShuffleArray(myArray)
For i = 0 To UBound(myArray)
[YOUR LABEL HERE] = myArray(i)
Next i
End Sub
Function ShuffleArray(OrigArray As Variant) As Variant
Dim RandNum As Long
Dim Holder As Variant
Dim ReturnArray() As Variant
ReDim ReturnArray(LBound(OrigArray) To UBound(OrigArray))
For i = LBound(OrigArray) To UBound(OrigArray)
ReturnArray(i) = OrigArray(i)
Next i
For i = LBound(OrigArray) To UBound(OrigArray)
RandNum = Int((UBound(OrigArray) - LBound(OrigArray)) * Rnd + LBound(OrigArray))
If i <> RandNum Then
Holder = ReturnArray(i)
ReturnArray(i) = ReturnArray(RandNum)
ReturnArray(RandNum) = Holder
End If
Next i
ShuffleArray = ReturnArray
End Function
This will read the file put each line into an array and then will Shuffle the array. It will then loop through the shuffled array which is where you will need to include your labels for output of the questions.
Need a function that will accept a filename as parameter and then return the number of lines in that file.
Should be take under 30 seconds to get the count of a 10 million line file.
Currently have something along the lines of - but it is too slow with large files:
Dim objFSO, strTextFile, strData, arrLines, LineCount
CONST ForReading = 1
'name of the text file
strTextFile = "sample.txt"
'Create a File System Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Open the text file - strData now contains the whole file
strData = objFSO.OpenTextFile(strTextFile,ForReading).ReadAll
'Split by lines, put into an array
arrLines = Split(strData,vbCrLf)
'Use UBound to count the lines
LineCount = UBound(arrLines) + 1
wscript.echo LineCount
'Cleanup
Set objFSO = Nothing
If somebody still looking for faster way, here is the code:
Const ForAppending = 8
Set fso = CreateObject("Scripting.FileSystemObject")
Set theFile = fso.OpenTextFile("C:\textfile.txt", ForAppending, Create:=True)
WScript.Echo theFile.Line
Set Fso = Nothing
Of course, the processing time depend very much of the file size, not only of the lines number. Compared with the RegEx method TextStream.Line property is at least 3 times quicker.
The only alternative I see is to read the lines one by one (EDIT: or even just skip them one by one) instead of reading the whole file at once. Unfortunately I can't test which is faster right now. I imagine skipping is quicker.
Dim objFSO, txsInput, strTemp, arrLines
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
strTextFile = "sample.txt"
txsInput = objFSO.OpenTextFile(strTextFile, ForReading)
'Skip lines one by one
Do While txsInput.AtEndOfStream <> True
txsInput.SkipLine ' or strTemp = txsInput.ReadLine
Loop
wscript.echo txsInput.Line-1 ' Returns the number of lines
'Cleanup
Set objFSO = Nothing
Incidentally, I took the liberty of removing some of your 'comments. In terms of good practice, they were superfluous and didn't really add any explanatory value, especially when they basically repeated the method names themselves, e.g.
'Create a File System Object
... CreateObject("Scripting.FileSystemObject")
Too large files...
The following is the fastest-effeciently way I know of:
Dim oFso, oReg, sData, lCount
Const ForReading = 1, sPath = "C:\file.txt"
Set oReg = New RegExp
Set oFso = CreateObject("Scripting.FileSystemObject")
sData = oFso.OpenTextFile(sPath, ForReading).ReadAll
With oReg
.Global = True
.Pattern = "\r\n" 'vbCrLf
'.Pattern = "\n" ' vbLf, Unix style line-endings
lCount = .Execute(sData).Count + 1
End With
WScript.Echo lCount
Set oFso = Nothing
Set oReg = Nothing
You could try some variation on this
cnt = 0
Set fso = CreateObject("Scripting.FileSystemObject")
Set theFile = fso.OpenTextFile(filespec, ForReading, False)
Do While theFile.AtEndOfStream <> True
theFile.SkipLine
c = c + 1
Loop
theFile.Close
WScript.Echo c,"lines"
txt = "c:\YourTxtFile.txt"
j = 0
Dim read
Open txt For Input As #1
Do While Not EOF(1)
Input #1, read
j = j + 1
Loop
Close #1
If it adds an empty last line the result is (j - 1).
It works fine for one column in the txt file.
How to count all lines in the notepad
Answers:
=> Below is the code -
Set t1=createObject("Scripting.FileSystemObject")
Set t2=t1.openTextFile ("C:\temp\temp1\temp2_VBSCode.txt",1)
Do Until t2.AtEndOfStream
strlinenumber = t2.Line
strLine = t2.Readline
Loop
msgbox strlinenumber
t2.Close
I was looking for a faster way than what I already had to determine the number of lines in a text file. I searched the internet and came across 2 promising solution. One was a solution based on SQL thew other the solution I found here based on Fso by Kul-Tigin. I tested them and this is part of the result:
Number of lines Time elapsed Variant
--------------------------------------------------------
110 00:00:00.70 SQL
110 00:00:00.00 Vanilla VBA (my solution)
110 00:00:00.16 FSO
--------------------------------------------------------
1445014 00:00:17.25 SQL
1445014 00:00:09.19 Vanilla VBA (my solution)
1445014 00:00:17.73 FSO
I ran this several times with large and small numbers. Time and again the vanilla VBA came out on top. I know this is far out of date, but for anyone still looking for the fastest way to determine the number of lines in a csv/text file, down here's the code I use.
Public Function GetNumRecs(ASCFile As String) As Long
Dim InStream As Long
Dim Record As String
InStream = FreeFile
GetNumRecs = 0
Open ASCFile For Input As #InStream
Do While Not EOF(InStream)
Line Input #InStream, Record
GetNumRecs = GetNumRecs + 1
Loop
Close #InStream
End Function