VB 6 + Capture text from file and copy it to form window - vb6

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.

Related

Open a Word Document on the file list box with a command button

So I have a filelistbox along with dir and drivelistboxes. I'm trying to open a word (.docx) file shown on the filelistbox when I press/click the "Open" Command Button that I created but it popups an:
Error 5151 Words Was Unable to read this document. It may be corrupt.
Try one or more of the following"Open and repair the file." "Open the
file with the Text Recovery converter. (C:\Documents and Settings\JHON
Clarence\Desktop\ *.docx)"
Here is my code for the command button:
Private Sub cmdopen_Click()
Dim nAns As Long
Dim objFile As String
Dim objpath As String
Dim objname As String
objpath = Dir1.Path & "\"
objname = "*.docx"
objFile = objpath & objname
nAns = MsgBox("Please confirm to open file ' " & objFile & "'?'", vbQuestion & vbYesNo)
If nAns = vbYes Then
Set objWord = CreateObject("Word.Application")
objWord.Visible = True
Set objDoc = objWord.Documents.Open(objFile)
End If
End Sub
The Debug highlights Set objDoc = objWord.Documents.Open(objFile)
I have a hunch that the problem is about the objname = "*.docx" although I don't know how to open any word file (.docx) without typing any file name.

Text files handles differently

I am trying to read from a csv.txt file using Ado Recordset
I get no results back when trying..
When I copy the contents of the original file into a new text file, and read from that file, it works just fine.
Any ideas what the reason for this might be?
The second file is smaller in size, about 1/2. That's the only difference I can see. This is driving me mad :-)
'Edit
Update with code & schema.ini
Code:
Sub ImportTextFiles()
Dim objAdoDbConnection As ADODB.Connection
Dim objAdoDbRecordset As ADODB.Recordset
Dim strAdodbConnection As String
Dim pathSource As String
Dim filename As String
pathSource = "C:\Users\me\Desktop\Reports\"
filename = "test1.txt"
'filename = "test2.txt"
strAdodbConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source=" & pathSource _
& ";Extended Properties=""text;HDR=yes;FMT=Delimited"";"
Set objAdoDbConnection = CreateObject("Adodb.Connection")
Set objAdoDbRecordset = CreateObject("ADODB.Recordset")
With objAdoDbConnection
.Open (strAdodbConnection)
With objAdoDbRecordset
.Open "Select top 10 * FROM " & filename & " WHERE [Date] > #01/01/2000# ", objAdoDbConnection, adOpenStatic, adLockOptimistic, adCmdText
If Not objAdoDbRecordset.EOF Then objAdoDbRecordset.MoveFirst
Do While Not objAdoDbRecordset.EOF
Debug.Print "Field(0): " & objAdoDbRecordset(0).Value
objAdoDbRecordset.MoveNext
Loop
.Close
End With
.Close
End With
Set objAdoDbRecordset = Nothing
Set objAdoDbConnection = Nothing
End Sub
Schema.ini:
[Test1.txt]
col1=date text
col2=interval integer
col3=application text
[Test2.txt]
col1=date text
col2=interval integer
col3=application text
notepadd++ gave me the answer, file1 is ucs-2 encoded, the newly created utf-8

Populate GPO from Text File using VBScript or other

Ok, so we need to create a GPO that allows our users to only use specific programs.
GPO Location:
User Configuration
Policies
Administrative Templates [...]
System
Run only specified Windows applications
Then setting the GPO to enabled and clicking on List of allowed applications --> Show...
I have created an excel spreadsheet containing the names of all the programs and their associated executable files with other pertinent information so that we can easily organize, add, delete, etc. the executable files that we need to allow our users access to.
This spreadsheet then dumps all the executable files into a text file.
Here is an example of what the text file looks like:
Acrobat.exe
chrome.exe
calc.exe
.
.
.
There are a lot of entries and these are likely subject to change. What I am trying to do is create a script that will take that text file and populate the GPO automatically. I don't care if we have to open the window and then run it, it does not need to run from the task scheduler (although that would be amazing if someone has that code ready). We just need it to populate this ridiculous amount of executable filenames into the fields.
Here is code I found (VBScript) that when run, should populate the fields automatically, however I cannot get it to run in the Group Policy Management Editor (it runs in the windows explorer window instead and ends up searching for some of the files)
' Open the text file, located in the same path as the script
Set objFSO = CreateObject("Scripting.FileSystemObject")
strPath = Mid(Wscript.ScriptFullName, 1, InStrRev(Wscript.ScriptFullName, wscript.ScriptName) -1)
Set objFile = objFSO.OpenTextFile(strPath & "appList.txt")
' Activate the "Show Contents" window with the "List of allowed applications".
' Note the window must be opened already and we should have selected where in
' the list we want to enter the data before running the script
set WshShell = WScript.CreateObject("WScript.Shell")
WScript.Sleep 1000
WshShell.AppActivate "Show Contents"
' Read the file line by line
Do While objFile.AtEndOfStream <> True
' Each line contains one EXE name
exeName = objFile.ReadLine
' Escape forbidden chars { } [ ] ( ) + ^ % ~
exeName = Replace(exeName, "[", "{[}")
exeName = Replace(exeName, "]", "{]}")
exeName = Replace(exeName, "(", "{(}")
exeName = Replace(exeName, ")", "{)}")
exeName = Replace(exeName, "+", "{+}")
exeName = Replace(exeName, "^", "{^}")
exeName = Replace(exeName, "%", "{%}")
exeName = Replace(exeName, "~", "{~}")
' Send the EXE name to the window
WScript.Sleep 100
WshShell.SendKeys exeName
' Move to the next one
WshShell.SendKeys "{TAB}"
Loop
objFile.Close
from: http://blogs.msdn.com/b/alejacma/archive/2011/03/24/how-to-update-quot-run-only-specified-windows-applications-quot-gpo-programmatically-vbscript.aspx
"C:\Windows\System32\GroupPolicy\User\Registry.pol"
Is where my policies are stored. It's a semi text file. Try writing to that file.
Ok, so I tried it many different ways. If anyone is looking for an answer to do this, this is the way I've figured it out and the way I've decided to proceed. I will post all relevant code below.
In Excel, the format of my table is as follows:
(With obviously WAY more entries)
Here is the VBA code I used to turn the data from this file into the proper format for the registry key:
VBA - In Excel
Public Sub ExportToTextFile(FName As String, _
Sep As String, SelectionOnly As Boolean, _
AppendData As Boolean)
Dim WholeLine As String
Dim FNum As Integer
Dim RowNdx As Long
Dim ColNdx As Integer
Dim StartRow As Long
Dim EndRow As Long
Dim StartCol As Integer
Dim EndCol As Integer
Dim CellValue As String
Application.ScreenUpdating = False
On Error GoTo EndMacro:
FNum = FreeFile
StartRow = 2
If SelectionOnly = True Then
With Selection
StartCol = .Cells(2).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(2).Column
End With
Else
With ActiveSheet.UsedRange
StartCol = .Cells(2).Column
EndRow = .Cells(.Cells.Count).Row
EndCol = .Cells(2).Column
End With
End If
If AppendData = True Then
Open FName For Append Access Write As #FNum
Else
Open FName For Output Access Write As #FNum
End If
For RowNdx = StartRow To EndRow
WholeLine = ""
For ColNdx = StartCol To EndCol
If Cells(RowNdx, ColNdx).Value = "" Then
CellValue = ""
Else
CellValue = Cells(RowNdx, ColNdx).Value
End If
WholeLine = WholeLine & Chr(34) & CellValue & ".exe" & Chr(34) & "=" & Chr(34) & CellValue & ".exe" & Chr(34) & Sep
Next ColNdx
WholeLine = Left(WholeLine, Len(WholeLine) - Len(Sep))
Print #FNum, WholeLine; ""
Next RowNdx
EndMacro:
On Error GoTo 0
Application.ScreenUpdating = True
Close #FNum
End Sub
Sub PipeExport()
Dim FileName As Variant
Dim Sep As String
FileName = Application.GetSaveAsFilename(InitialFileName:="appList", filefilter:="Text (*.txt),*.txt")
If FileName = False Then
''''''''''''''''''''''''''
' user cancelled, get out
''''''''''''''''''''''''''
Exit Sub
End If
Sep = "|"
If Sep = vbNullString Then
''''''''''''''''''''''''''
' user cancelled, get out
''''''''''''''''''''''''''
Exit Sub
End If
Debug.Print "FileName: " & FileName, "Extension: " & Sep
ExportToTextFile FName:=CStr(FileName), Sep:=CStr(Sep), _
SelectionOnly:=False, AppendData:=False
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
PipeExport
End Sub
The file that is created is appList.txt and its format is the same format as the registry key:
"Acrobat.exe"="Acrobat.exe"
"AcroRd32.exe"="AcroRd32.exe"
Now in your GPO, add a unique program name to the allowed applications list (say test1234.exe) and in your registry editor, go to Edit > Find test1234.exe.
Export that registry key under File > Export. Remove the test1234.exe line and paste in your text file. Then reimport that file and you're done!

How to store and then display picture using vb6 and oracle?

'code to load picture into database table
Private Function GetPic()
Dim filelen As Long
Dim numlock As Integer
Dim leftover As Long
Const blocksize = 100000
Dim pic As String
Dim bytedata() As Byte
Dim sfile As Integer
sql = "select PICS from student_record_database " //empty field with no pictures
RES.Open sql, CON, adOpenDynamic, adLockOptimistic
sfile = App.Path & "/mypic/Book1.xls" //error : type mismatch
Open sfile For Binary Access Read As #1
filelen = LOF(sfile)
If filelen = 0 Then
Close sfile
MsgBox ("empty or not found")
Else
numlock = filelen / blocksize
leftover = filelen Mod blocksize
ReDim bytedata(leftover)
Get sfile, , bytedata()
RES(1).AppendChunk bytedata()
ReDim bytedata(blocksize)
For i = 1 To numlock
Get sfile, , bytedata()
RES(1).AppendChunk bytedata()
Next i
RES.Update
Close sfile
End If
End Function
'code to display picture in picture box from table
Private Function ShowPic()
Dim bytedata() As Byte
Dim file As String
Dim filelen As Long
Dim numlock As Integer
Dim leftover As Long
Const blocksize = 100000
file = App.Path & "\image1.jpeg"
Open file For Binary As #1
numlock = filelen / blocksize
leftover = filelen Mod blocksize
bytedata() = RES(1).GetChunk(leftover)
Put file, , bytedata()
For i = 1 To numlock
bytedata() = RES(1).GetChunk(blocksize)
Put file, , bytedata()
Next i
Close file
End Function
Here is my full code to insert pictures using vb in an oracle table database.
Next I display those pictures in picture box of vb application as per their records, but it is showing an error of "type mismatch" and picture is not shown in picture box.
you declared sFile as an integer, but are trying to load a string in it
Dim sFile as string
sfile = App.Path & "/mypic/Book1.xls"

VBS Script tab not null

Earlier I have made a script to grab certain lines from a tabbed delimited text file, first row with each of the following rows into its own .txt file. (so these .txt files are only 2 rows of text)
Then it would move each .txt file by what text it found in the given tab in this case it was (1)(3) (second row - forth tab)
here is the code for the first part...
Call TwoDimensionArrayTest
Sub TwoDimensionArrayTest
Dim fso
Dim oFile
Dim arrline
Dim arrItem
Dim i
Dim arrMain()
Dim sFileLocation, strResults
Const forReading = 1
strFolder = "\\nas001\Production\RxCut\In Design Implementation\build\" '"
Set objFSO = CreateObject("Scripting.FileSystemObject")
For Each objFile In objFSO.GetFolder(strFolder).Files
If Right(LCase(objFile.Name), 4) = LCase(".txt") Then
''# The file contains on each line:
''# Text1 (tab) Text2 (tab) Text3 (tab) Text4
''# Text5 (tab) Text6 (tab) Text7 (tab) Text8
''# etc etc
Set fso = CreateObject("Scripting.FileSystemObject")
sFileLocation = objFile.Name
Set oFile = fso.OpenTextFile(objFile.Name, forReading, False)
Do While oFile.AtEndOfStream <> True
strResults = oFile.ReadAll
Loop
''# Close the file
oFile.Close
''# Release the object from memory
Set oFile = Nothing
''# Return the contents of the file if not Empty
If Trim(strResults) <> "" Then
''# Create an Array of the Text File
arrline = Split(strResults, vbNewLine)
End If
For i = 0 To UBound(arrline)
If arrline(i) = "" Then
''# checks for a blank line at the end of stream
Exit For
End If
ReDim Preserve arrMain(i)
arrMain(i) = Split(arrline(i), vbTab)
Next
fso.MoveFile sFileLocation, arrMain(1)(3) & ".txt"
End If
Next
End Sub ''# TwoDimensionArrayTest
Now moving on to the next part...
ok I have a tabbed delimited text file and in this file we have specified on first row 5th tab co-brand, 6th tab tri-brand, and 7th generic.
second row we have the directory path to whichever it maybe either co-brand, tri-brand or generic.
What I want to be able to do is move a given file we can call "group.txt" to either of those co-brand, tri-brand, or generic directories depending upon which field is NOT NULL.
How can I accomplish this? Would be nice to just be able to incorporate this into the last script towards the end where specified:
fso.MoveFile sFileLocation, arrMain(1)(3) & ".txt"
of course would depend from here what I mentioned above about the NOT NULL field.
Any help is greatly appreciated,
Joe
my guess is something like this at the end (maybe):
If not isNull(Rs("arrMain(1)(4)")) Then
Set sDirectory = "/co-brand"
End If
If not isNull(Rs("arrMain(1)(5)")) Then
Set sDirectory = "/tri-brand"
End If
If not isNull(Rs("arrMain(1)(6)")) Then
Set sDirectory = "/generic"
End If
fso.MoveFile sFileLocation, sDirectory, arrMain(1)(3) & ".txt"

Resources