I like make save state editor game but I have small problem and I hope someone help me for that is problem.
Public Sub SaveState(pFile As String)
If pFile = "" Then Exit Sub
Dim FF As Long
FF = FreeFile()
Open pFile For Binary As FF
' Save the Lives
If chkLive.value = 1 Then Put #FF, 117290 + 1, 1
Close #FF
End Sub
When I click in checkbox then save as, It is change TwoByte not Curval ?
Example:
In the save file game is live 02 but when I saved then I check in file I see like this:0200, I wonder what is wrong I do?
The , 1 that you are writing out is a 2-byte integer and so is writing two bytes. Try
Public Sub SaveState(pFile As String)
If pFile = "" Then Exit Sub
Dim FF As Long
Dim b as Byte
FF = FreeFile()
Open pFile For Binary As FF
' Save the Lives
b = 1
If chkLive.value = 1 Then Put #FF, 117290 + 1, b
Close #FF
End Sub
That way only one byte will be written to the file.
Related
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 ?
Suppose we have a 4-byte file with the following contents
00 00 00 00
I want to modify the first two bytes to say
FF AA 00 00
How can I accomplish this with vbscript? A reference for binary IO using vbscript would also be nice.
You could take a look at the example in the answer to this question: Read and write binary file in VBscript
I don't know how well this will work in practice (the mid function may mangle the results), but it seems to work here for me using the following code:
Option Explicit
Dim data
data = readBinary("C:\test.file")
' CHR(255) = FF, CHR(170) = AA
data = Chr(255)&Chr(170) & Mid(data, 3, Len(data) - 2)
writeBinary data,"C:\newtest.file"
Function readBinary(path)
Dim a, fso, file, i, ts
Set fso = CreateObject("Scripting.FileSystemObject")
Set file = fso.getFile(path)
If isNull(file) Then
wscript.echo "File not found: " & path
Exit Function
End If
Set ts = file.OpenAsTextStream()
a = makeArray(file.size)
i = 0
While Not ts.atEndOfStream
a(i) = ts.read(1)
i = i + 1
Wend
ts.close
readBinary = Join(a,"")
End Function
Sub writeBinary(bstr, path)
Dim fso, ts
Set fso = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
Set ts = fso.createTextFile(path)
If Err.number <> 0 Then
wscript.echo Err.message
Exit Sub
End If
On Error GoTo 0
ts.Write(bstr)
ts.Close
End Sub
Function makeArray(n)
Dim s
s = Space(n)
makeArray = Split(s," ")
End Function
I have absolutely no experience programming in excel vba other than I wrote a function to add a data stamp to a barcode that was scanned in on our production line a few weeks back, mainly through trial and error.
Anyways, what I need help with right now is inventory is coming up and every item we have has a barcode and is usually scanned into notepad and then manually pulled into excel and "text to columns" is used. I found the excel split function and would like a little bit of help getting it to work with my scanned barcodes.
The data comes in in the format: 11111*A153333*11/30/11 plus a carriage return , where the * would be the delimiter. All the examples I've found don't seem to do anything, at all.
For example here is one I found on splitting at the " ", but nothing happens if I change it to *.
Sub splitText()
'splits Text active cell using * char as separator
Dim splitVals As Variant
Dim totalVals As Long
splitVals = Split(ActiveCell.Value, "*")
totalVals = UBound(splitVals)
Range(Cells(ActiveCell.Row, ActiveCell.Column + 1), Cells(ActiveCell.Row, ActiveCell.Column + 1 + totalVals)).Value = splitVals
End Sub
And this is applied in the Sheet1 code section, if that helps.
It really can't be this complicated, can it?
Edit: Trying to add in Vlookup to the vba.
So as I said below in the comments, I'm now working on getting the vlookup integrated into this, however it just returns N/A.
Here is the sub I wrote based on the link below
Public Sub vlook(ByRef codeCell As Range)
Dim result As String
Dim source As Worksheet
Dim destination As Worksheet
Set destination = ActiveWorkbook.Sheets("Inventory")
Set source = ActiveWorkbook.Sheets("Descriptions")
result = [Vlookup(destination!(codeCell.Row, D), source!A2:B1397, 2, FALSE)]
End Sub
And I was trying to call it right after the For loop in the worksheet change, and just created another for loop, does this/should this be a nested for loop?
Just adding the code to the VBA behind the worksheet won't actually cause it to get called. You need to handle the worksheet_change event. The following should help:
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
Dim cell As Range
For Each cell In Target.Cells
If cell.Column = 1 Then SplitText cell
Next
Application.EnableEvents = True
End Sub
Public Sub SplitText(ByRef codeCell As Range)
'splits Text active cell using * char as separator
Dim splitVals As Variant
Dim totalVals As Long
splitVals = Split(codeCell.Value, "*")
totalVals = UBound(splitVals)
Range(Cells(codeCell.Row, codeCell.Column), Cells(codeCell.Row, codeCell.Column + totalVals)).Value = splitVals
End Sub
If you want to process the barcodes automatically on entering them, you need something like this (goes in the worksheet module).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim splitVals As Variant
Dim c As Range, val As String
For Each c In Target.Cells
If c.Column = 1 Then 'optional: only process barcodes if in ColA
val = Trim(c.Value)
If InStr(val, "*") > 0 Then
splitVals = Split(val, "*")
c.Offset(0, 1).Resize( _
1, (UBound(splitVals) - LBound(splitVals)) + 1 _
).Value = splitVals
End If
End If 'in ColA
Next c
End Sub
I am experimenting with drag and drop from an outlook email attachment to a custom application. It works just fine with C#, but now I'd like to get it working in VB6. My test code looks something like this:
Private Sub grdLis_OLEDragDrop(Data As MSFlexGridLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim FileDropped As String * 256
Dim lCF_FILEGROUP As Long
Dim CF_FILEGROUP As Integer
Dim lCF_FILECONTENTS As Long
Dim CF_FILECONTENTS As Integer
Dim bData() As Byte
Dim bFileNameData(256) As Byte
Dim bData2() As Byte
lCF_FILEGROUP = RegisterClipboardFormat("FileGroupDescriptor")
MoveMemory CF_FILEGROUP, lCF_FILEGROUP, 2
bData() = Data.GetData(CF_FILEGROUP)
j = 0
For i = 76 To 76 + 256
bFileNameData(j) = bData(i)
j = j + 1
Next i
FileDropped = Trim(StrConv(bFileNameData, vbUnicode))
lCF_FILECONTENTS = RegisterClipboardFormat("FileContents")
MoveMemory CF_FILECONTENTS, lCF_FILECONTENTS, 2
bData2() = Data.GetData(CF_FILECONTENTS)
This works to get the file name, but it throws an exception on the Data.GetData(CF_FILECONTENTS) call, and the error messages says "Automation error invalid tymed".
I don't have much experience in VB6, and I have no idea what that error message means or what to do about it. Any help or insight would be appreciated.
Check out Get dropped attachments from Outlook messages for more ideas. It's using OLE heavily.
Using VB 6
In my Project, when I copy the file from one folder to another folder, at the time I want to show the progress bar like copying…., Once the file was copied the Progress bar show’s 100 % Completed.
Code.
'File Copying
Private Sub Copy_Click()
Timer1.Enabled = True
Dim abc As Integer
Dim line As String
abc = FreeFile
Open App.Path & "\DatabasePath.TXT" For Input As #abc
Input #abc, line
databasetext = line
Dim fs As New FileSystemObject, f As File
Set f = fs.GetFile(databasetext)
f.Copy App.Path & "\"
Set fs = Nothing
Close #abc
End Sub
Private Sub Timer1_Timer()
ProgressBar1.Min = 0
ProgressBar1.Max = 100
ProgressBar1.Value = ProgressBar1.Value + 1
If ProgressBar1.Value = ProgressBar1.Max Then
Timer1.Enabled = False
End If
End Sub
Above code Is working, But when I click copy button, Progressbar1 is not displaying, once the file was copied to another folder. Then only progressbar1 is stating.
Both will not working simultaneously.
And Also Once the file was copied, then progress bar should display 100 %. Now it is not displaying correctly, Still the file is copying, Progress bar is showing 100 %
Can any one help to solve the problem.
Need VB 6 Code Help.
If the standard copy function is blocking the timer from firing then the best thing you can do is write your own copy which reads the source file a few thousand bytes at a time and writes it to the destination file.
Between each read and write operation you need to update your progress bar and (possibly) call DoEvents to make sure it redraws.
Also your timer code makes no sense. It just arbitrarily increases progress every time if fires without reference to how much progress has actually been made. You would be better off passing the progress bar to your copy function so that it can updated as you go.
Something like this would do it:
Private Sub Copy_Click()
Dim abc As Integer
Dim line As String
abc = FreeFile
Open App.Path & "\DatabasePath.TXT" For Input As #abc
Input #abc, line
copyFile line, App.Path & "\" & line, ProgressBar1
Close #abc
End Sub
Sub copyFile(inFile As String, outFile As String, ByRef pg As ProgressBar)
Close
Const chunkSize = 1024
Dim b() As Byte
fhIn = FreeFile
Open inFile For Binary Access Read As #fhIn
fhOut = FreeFile
Open outFile For Binary Access Write As #fhOut
toCopy = LOF(fhIn) 'gets the size of the file
fileSize = toCopy
pb.Min = 0
pb.Max = toCopy
While toCopy > 0
If toCopy > chunkSize Then
ReDim b(1 To chunkSize)
toCopy = toCopy - chunkSize
Else
ReDim b(1 To toCopy)
toCopy = 0
End If
Get #fhIn, , b
Put #fhOut, , b
pg.Value = fileSize - toCopy
DoEvents
Wend
Close #fhIn
Close #fhOut
End Sub
For a progress bar to function, it either has to be updated inline with a periodic loop, or run in a separate thread.
The copy in old school VB6 is a blocking command. So even DoEvents will give the same result (the file will copy, then the progress bar will show up). If you are copying large files over a slow medium and you need to be able to show progress, then you should create the target file and move over bytes in chunks in a loop, in that loop you could update your progress bar. Sadly for the example given in the OP you won't get what you are looking for since every operation is synchronous.
EDIT: Beaten by the guy above me :)