I am making a number generator for my own purpose.
I already made it to work with these features:
- Saves the generated number
What features I want :
- When I close it loads the last generated number from the notepad.
here is the code:
Private Const FilePath As String = "C:\Users\sto0007404\Documents\Numbers.txt"
Private CurrentNumber As Long
Private Sub Command1_Click()
CurrentNumber = CurrentNumber + 1
txtRefNo.Text = "EM" & Format(CurrentNumber, String(4, "0"))
End Sub
Private Sub Form_Load()
Dim TextFileData As String, MyArray() As String, i As Long
' Open file as binary
Open "FilePath" For Binary As #1
' Read entire file's data in one go
TextFileData = Space$(LOF(1))
Get #1, , TextFileData
' Close File
Close #1
' Split the data in separate lines
MyArray() = Split(TextFileData, vbCrLf)
For i = 0 To UBound(MyArray())
' Set CurrentNumber equal to the current max
CurrentNumber = Val(Mid$(MyArray(i), 2))
Next
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
Dim i As Long
' delete the old file
If Not LenB(Dir(FilePath)) = 0 Then Kill FilePath
'open the file for writing
Open FilePath For Output As #1
For i = 1 To CurrentNumber
Write #1, "EM" & Format(i, String(4, "0"))
Next
'close the file (if you dont do this, you wont be able to open it again!)
Close #1
End Sub
Independent of use binary mode...
open file for output as #1
print #1, "Some text"
close #1
open file for input as #1
line input #1, myvariable
close #1
msgbox myvariable
The flow is the same that you show, so what is the problem ?
Related
I would like to read a specific line in a .txt file in a vb 6.0 program. My intrest is where a particular line where a certain text appears. I am trying to apply this code which I got from another project.
Dim strLine As String
Open "E:\Projects\VB\Ubunifu\MyList.txt" For Input As #1
Line Input #1, strLine ' read one line at a time vs entire file
lblCurrent.Caption = strLine
Line Input #1, strLine
lblO.Caption = strLine
Close #1
however this doesnt seem to be working it says "input past end of file"
You can try this:
Private Sub Form_Load()
Text1.MultiLine = True
Open "E:\Projects\VB\Ubunifu\MyList.txt" For Input As #1
Text1.Text = Input$(LOF(1), #1)
lblCurrent.Caption = udf_ReadLine(Text1.Text, 1) ' read line #1
lblCurrent_i.Caption = udf_ReadLine(Text1.Text, 2) ' read line #2
Close #1
End Sub
Private Function udf_ReadLine(ByVal sDataText As String, ByVal nLineNum As Long) As String
Dim sText As String, nI As Long, nJ As Long, sTemp As String
On Error GoTo ErrHandler
sText = ""
nI = 1
nJ = 1
sTemp = ""
While (nI <= Len(sDataText))
Select Case Mid(sDataText, nI, 1)
Case vbCr
If (nJ = nLineNum) Then
sText = sTemp
End If
Case vbLf
nJ = nJ + 1
sTemp = ""
Case Else
sTemp = sTemp & Mid(sDataText, nI, 1)
End Select
nI = nI + 1
Wend
If (nJ = nLineNum) Then
sText = sTemp
End If
udf_ReadLine = sText
Exit Function
ErrHandler:
udf_ReadLine = ""
End Function
I just added a function to read line from a string, and you can keep using the LOF function as you wish, also all of the concept from your original code.
First, if you had searched for your error you would have found the cause, https://msdn.microsoft.com/en-us/library/aa232640(v=vs.60).aspx.
Second, you need to do something to ensure there is anything in the file to read. https://msdn.microsoft.com/en-us/library/aa262732(v=vs.60).aspx
Finally, use a loop to read lines from the file. It appears you want the first line displayed in one label and the second line displayed in another. The code below reads one line at a time from the file, decides if it is reading an odd line number (first line) or even line number (second line) and displays the line in the label. After each line is read it looks for "a certain text" whatever that may be, and if found it exits the loop and closes the file.
Open "E:\Projects\VB\Ubunifu\MyList.txt" For Input As #1
Do While EOF(1) = False
Line Input #1, strLine ' read one line at a time vs entire file
lngLineNum = lngLineNum + 1 'Am I reading an odd or even line number
If lngLineNum Mod 2 <> 0 Then
lblCurrent.Caption = strLine
Else
lblO.Caption = strLine
End If
If InStr(1, strLine, "a cetain text", vbTextCompare) > 0 Then
Exit Do
End If
Loop
Close #1
Note that I did not check that strLine contained anything before calling InStr. If it is empty the InStr function will cause an error. You should add some defensive coding. At the very least an error handler.
I have a macro that reads a .txt file line by line. I check every line if it's equal to some code for a new page, say it's "NEXT" - if yes, then a page break is inserted. After certain amount of "NEXT" occurences the whole document gets exported to pdf. Then the content of .doc gets deleted and I continue reading & exporting the txt file until EOF.
Problem: macro gets slower with every execution.
My test file has 27300 lines / 791 kB (real files are somewhere between 10 and 100MB). Before I start the macro, the WINWORD process takes 40K of memory. The memory usage gets bigger after every execution of the macro.
Time Max.MemoryUsage MemoryUsageAfterwards
Run1 11.9s 70K 64K
Run2 19.7s 90K 84K
Run3 22.3s 99K 92K
I know a partial solution is to close and reopen the .doc file manually and run the macro with next .txt file as input. However, it takes long time to even close the Word after one run of macro, although there is no content in the file that I can see.
What I'm asking is if there is another way to solve this, what I believe is to be a memory clearing issue?
My code:
When the document is opened:
Private Sub Document_Open()
ReadAndSplit
End Sub
Global variables and declarations:
Option Explicit
'---------------------------------------------------------------------------
' GLOBAL VARIABLES
'---------------------------------------------------------------------------
Public numOfBreaks As Integer ' number of page breaks made
Public numOfPdfs As Integer ' number of currently printed pdf
Public filePrefix As String ' name prefix for .pdf files
Public sFileName As String ' name of Input File
Public breakAfter As Integer ' print after this number of NEXT
Public cancelActive As Boolean ' cancel Button pressed? (for exit)
Main macro:
Sub ReadAndSplit()
'---------------------------------------------------------------------------
' VARIABLES
'---------------------------------------------------------------------------
Dim sLine As String ' line from text file
Dim numOfLines As Long ' number of lines read from .txt input
Dim execStart As Single ' starting time of script execution
Dim nextPage As Boolean ' indicates if new document beginns
'---------------------------------------------------------------------------
' INITIAL PROCESSING
'---------------------------------------------------------------------------
Application.Visible = False
Application.ScreenUpdating = False
Selection.WholeStory ' clear the document
Selection.Delete
UserForm1.Show ' show user dialog
If cancelActive Then ' Cancel button handling
Application.Visible = True
Exit Sub
End If
With ActiveDocument.PageSetup ' set page margins & orientation
.TopMargin = 0.1
.BottomMargin = 0.1
.LeftMargin = 0.1
.RightMargin = 0.1
End With
'---------------------------------------------------------------------------
' MAIN PROCESSING
'---------------------------------------------------------------------------
numOfBreaks = 0 ' GLOBALS
numOfPdfs = 1
numOfLines = 0 ' LOCALS
nextPage = True
execStart = Timer
Open sFileName For Input As #1
Do While Not EOF(1)
If nextPage Then ' write 2 empty lines
Selection.TypeText (vbNewLine & vbNewLine)
nextPage = False
End If
Line Input #1, sLine ' read 1 line from input
numOfLines = numOfLines + 1 ' count lines
If sLine <> "NEXT" Then ' test for NEXT
Selection.TypeText (sLine) & vbNewLine ' write line from input .txt
Else
Selection.InsertBreak Type:=wdPageBreak ' NEXT -> new page
numOfBreaks = numOfBreaks + 1 ' count new receipts
If numOfBreaks = breakAfter Then ' compare with PARAM
PrintAsPDF ' export to pdf
numOfBreaks = 0
End If
nextPage = True ' switch new page on
End If
Loop
If numOfBreaks <> 0 Then ' print out the last part
PrintAsPDF
End If
Close #1
Debug.Print vbNewLine & "-----EXECUTION-----"
Debug.Print Now
Debug.Print "Lines: " & numOfLines
Debug.Print "Time: " & (Timer - execStart)
Debug.Print "-------------------" & vbNewLine
Selection.WholeStory ' clear the word document
Selection.Delete
Application.Visible = True
End Sub
Macro used for printing PDF:
Sub PrintAsPDF()
Dim newPdfFileName As String ' path + name for current .pdf file
newPdfFileName = ActiveDocument.Path & "\" & filePrefix & "-" & numOfPdfs & ".pdf"
Selection.WholeStory ' set font
With Selection.Font
.Name = "Courier New"
.Size = 10.5
End With
ActiveDocument.SaveAs2 newPdfFileName, 17
numOfPdfs = numOfPdfs + 1
Selection.WholeStory
Selection.Delete
End Sub
UserForm code:
'---------------------------------------------------------------------------
' OK BUTTON
'---------------------------------------------------------------------------
Private Sub OKButton_Click()
Dim inputFileOk As Boolean ' input file path
Dim inputSplitOk As Boolean ' split
Dim prefixOk As Boolean ' prefix
If FileTxtBox.Text = vbNullString Then ' validate file path
inputFileOk = False
MsgBox ("File path missing!")
Else
inputFileOk = True
End If
If IsNumeric(SplitTxtBox.Text) Then ' validate breakAfter
breakAfter = SplitTxtBox.Text
inputSplitOk = True
Else
MsgBox ("Non-numeric value for SPLIT!")
End If
If PrefixTxtBox <> vbNullString Then ' validate prefix
filePrefix = PrefixTxtBox.Text
prefixOk = True
Else
MsgBox ("Missing prefix!")
End If
' check if all inputs are ok
If inputFileOk And inputSplitOk And prefixOk Then
cancelActive = False
Unload Me
End If
End Sub
'---------------------------------------------------------------------------
' CANCEL BUTTON
'---------------------------------------------------------------------------
Private Sub CancelButton_Click()
cancelActive = True ' for script termination
Unload Me
End Sub
'---------------------------------------------------------------------------
' FILE BUTTON
'---------------------------------------------------------------------------
Private Sub FileButton_Click()
Dim i As Integer ' file selection index
' show file chooser dialog and assign selected file to sFileName
Application.FileDialog(msoFileDialogOpen).AllowMultiSelect = False
i = Application.FileDialog(msoFileDialogOpen).Show
If i <> 0 Then
sFileName = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
FileTxtBox.Text = sFileName
End If
End Sub
Word stores a lot of information in "temp" files in order to track "unlimited" Undo. If you perform a lot of actions without saving the file or clearing the Undo buffer, this slows Word down. I recommend, therefore:
Clear the Undo buffer (ActiveDocument.UndoClear)
Save the (empty) document periodically
in order to free resources.
I need to send a file to some electronic device and execute it.
I couldn't find any information online regarding MS Comms and I didn't find Documentation on the Microsoft (https://msdn.microsoft.com/en-us/library/aa231237(v=vs.60).aspx) any useful :
' Send Byte array data
MSComm1.Output = Out
Would be great if you guys could give me some pointers and help me to solve my problem. The problem that I am experiencing is an infinite loop at Loop Until MSComm1.OutBufferCount = 0, when I return "MSComm1.OutBufferCount" between Do and Loop "MSComm1.OutBufferCount" is 0 and files dont seem to be sent over to the device.
Closest function I got to at the present moment is below:
Function SendFile(tmp$)
Dim temp$
Dim hsend, bsize, LF&
' Open file
Open tmp$ For Binary Access Read As #2
' Check size on Mscomm1 OutBuffer
bsize = MSComm1.OutBufferSize
' Check file length
LF& = LOF(2)
' This code makes tiny pieces of data (Buffer sized)
' And send's it
Do Until EOF(2)
If LF& - Loc(2) <= bsize Then
bsize = LF& - Loc(2) + 1
End If
' Make room for some data
temp$ = Space$(bsize)
' Put the data piece in the Temp$ string
Get #2, , temp$
MSComm1.Output = temp$
Do
' Wait until the buffer is empty
Loop Until MSComm1.OutBufferCount = 0
Loop
' close file
Close #2
End Function
Have a look at the RThreshold and SThreshold properties
Below is a simple example project :
'1 form with :
' 1 label control : name=Label1
' 1 textbox control : name=Text1
' 1 command button : name=Command1
Option Explicit
Private Sub Command1_Click()
'send command
MSComm1.Output = Text1.Text & vbCr
End Sub
Private Sub Form_Load()
'config mscomm control and open connection
With MSComm1
.Settings = "9600,N,8,1"
.RThreshold = 1
.SThreshold = 0
.CommPort = 1
.PortOpen = True
End With 'MSComm1
End Sub
Private Sub Form_Resize()
'position controls
Dim sngWidth As Single, sngHeight As Single
Dim sngCmdWidth As Single, sngCmdHeight As Single
Dim sngTxtWidth As Single
Dim sngLblHeight As Single
sngWidth = ScaleWidth
sngHeight = ScaleHeight
sngCmdWidth = 1215
sngCmdHeight = 495
sngLblHeight = sngHeight - sngCmdHeight
sngTxtWidth = sngWidth - sngCmdWidth
Label1.Move 0, 0, sngWidth, sngLblHeight
Text1.Move 0, sngLblHeight, sngTxtWidth, sngCmdHeight
Command1.Move sngTxtWidth, sngLblHeight, sngCmdWidth, sngCmdHeight
End Sub
Private Sub MSComm1_OnComm()
'process received data
Dim strInput As String
Select Case MSComm1.CommEvent
Case comEvReceive
strInput = MSComm1.Input
Label1.Caption = Label1.Caption & strInput
End Select
End Sub
In Command1_Click I add a carriage return to the command from Text1 as most devices require the command to be finished by that
In MSComm1_OnComm I just print the received data to the label, but you might want to add the received data to a global variable, and then process the contents of that variable, as all data might not be received at once
I know how to do it in VB.Net but not an idea in vb6.
What I what to achieve is to avoid reading the whole file.
Is that possible?
You could open the file using Random access. Work your way backward a byte at a time, counting the number of carriage return line feed character pairs. Store each line in an array, or something similar, and when you've read your 400 lines, stop.
Cometbill has a good answer.
To open file for Random access:
Open filename For Random Access Read As #filenumber Len = reclength
To get the length of the file in Bytes:
FileLen(ByVal PathName As String) As Long
To read from Random access file:
Get [#]filenumber,<[recnumber]>,<varname>
IMPORTANT: the <varname> from the Get function must be a fixed length string Dim varname as String * 1, otherwise it will error out with Bad record length (Error 59) if the variable is declared as a variable length string like this Dim varname as String
EDIT:
Just wanted to point out that in Dim varname as String * 1 you are defining a fixed length string and the length is 1. This is if you wish to use the read-1-byte-backwards approach. If your file has fixed length records, there is no need to go 1 byte at a time, you can read a record at a time (don't forget to add 2 bytes for carriage return and new line feed). In the latter case, you would define Dim varname as String * X where X is the record length + 2. Then a simple loop going backwards 400 times or untill reaching the beginning of the file.
The following is my take on this. This is more efficient than the previous two answers if you have a very large file, since we don't have to store the entire file in memory.
Option Explicit
Private Sub Command_Click()
Dim asLines() As String
asLines() = LoadLastLinesInFile("C:\Program Files (x86)\VMware\VMware Workstation\open_source_licenses.txt", 400)
End Sub
Private Function LoadLastLinesInFile(ByRef the_sFileName As String, ByVal the_nLineCount As Long) As String()
Dim nFileNo As Integer
Dim asLines() As String
Dim asLinesCopy() As String
Dim bBufferWrapped As Boolean
Dim nLineNo As Long
Dim nLastLineNo As Long
Dim nNewLineNo As Long
Dim nErrNumber As Long
Dim sErrSource As String
Dim sErrDescription As String
On Error GoTo ErrorHandler
nFileNo = FreeFile
Open the_sFileName For Input As #nFileNo
On Error GoTo ErrorHandler_FileOpened
' Size our buffer to the number of specified lines.
ReDim asLines(0 To the_nLineCount - 1)
nLineNo = 0
' Read all lines until the end of the file.
Do Until EOF(nFileNo)
Line Input #nFileNo, asLines(nLineNo)
nLineNo = nLineNo + 1
' Check to see whether we have got to the end of the string array.
If nLineNo = the_nLineCount Then
' In which case, flag that we did so, and wrap back to the beginning.
bBufferWrapped = True
nLineNo = 0
End If
Loop
Close nFileNo
On Error GoTo ErrorHandler
' Were there more lines than we had array space?
If bBufferWrapped Then
' Create a new string array, and copy the bottom section of the previous array into it, followed
' by the top of the previous array.
ReDim asLinesCopy(0 To the_nLineCount - 1)
nLastLineNo = nLineNo
nNewLineNo = 0
For nLineNo = nLastLineNo + 1 To the_nLineCount - 1
asLinesCopy(nNewLineNo) = asLines(nLineNo)
nNewLineNo = nNewLineNo + 1
Next nLineNo
For nLineNo = 0 To nLastLineNo
asLinesCopy(nNewLineNo) = asLines(nLineNo)
nNewLineNo = nNewLineNo + 1
Next nLineNo
' Return the new array.
LoadLastLinesInFile = asLinesCopy()
Else
' Simply resize down the array, and return it.
ReDim Preserve asLines(0 To nLineNo)
LoadLastLinesInFile = asLines()
End If
Exit Function
ErrorHandler_FileOpened:
' If an error occurred whilst reading the file, we must ensure that the file is closed
' before reraising the error. We have to backup and restore the error object.
nErrNumber = Err.Number
sErrSource = Err.Source
sErrDescription = Err.Description
Close #nFileNo
Err.Raise nErrNumber, sErrSource, sErrDescription
ErrorHandler:
Err.Raise Err.Number, Err.Source, Err.Description
End Function
The following VB 6 code saves text from the textBox in the form GUI to file.txt (By the click on the button)
How to do the reverse option – copy/capture file text (file.txt) , and passed it on the textBox in the form GUI , I will happy to get real example
remark - (before passed need to clear the form window from any text )
Private Sub save_Click()
saves = (Form1.Caption)
FCO.CreateTextFile App.Path & "\" & saveas & "file.txt", True
FCO.OpenTextFile(App.Path & "\" & saveas & "file.txt", ForWriting).Write Text1.Text
End Sub
This reads from a file and puts the results in Text1.Text.
Private Sub save_Click()
Dim sFile as String
sFile = "c:\whatever"
Dim sData as String
Dim fnum as Integer
fnum = FreeFile()
Open sFile For Input As #fnum
If Not eof(fnum) Then
Input #fnum, sData
Text1.Text= sData
End If
Close #fnum
End Sub
You can load in the contents of a file using the standard VB6 file I/O operations
Dim FileNum As Integer
Dim Size As Long
Dim Data() As Byte
'Open the file
FileNum = FreeFile()
Open FileName For Binary As #FileNum
'Read all the data
Size = LOF(FileNum)
ReDim Data(Size - 1)
Get #FileNum, , Data
Close #FileNum
'Convert to a string
TextBox.Text = StrConv(Data, vbUnicode)
See the original article.