here is my code , am trying to load html file from app.path how ever it is not populating all the data only half of it, am not sure why.
i expected the data to be populated till the end of the file.
Public Function ReadTextFileIntoString(strPathToFile As String) As String
Dim objFSO As New FileSystemObject
Dim objTxtStream As TextStream
Dim strOutput As String
Set objTxtStream = objFSO.OpenTextFile(strPathToFile)
Do Until objTxtStream.AtEndOfStream
strOutput = strOutput + objTxtStream.ReadLine
Loop
objTxtStream.Close
Text1.text = Text1.text & strOutput
End Function
Private Sub Command8_Click()
'Open App.Path & "\" & "File.html" For Input As #1
ReadTextFileIntoString App.Path & "\" & "File.html"
End Sub
Related
In continuation of Call VBScript from Windows Explorer Context Menu, I managed to get a VBScript file running from SendTo in the Windows Explorer.
I've changed my code to copy the file that invokes the script to my Temp folder. The new problem is that if the path is over 256 characters, I can't loop through WScript.Arguments to get all of it. Is there another way to get the full path (including the file name and it's extension)?
Option Explicit
Call OpenDocuWorksFile
Sub OpenDocuWorksFile()
Const sTitle = "Open DocuWorks File"
Dim iArgumentsCount
Dim iArgument
Dim sFilePath
Dim sTempFolder
Dim oFileScriptingObject
Dim sFileName
Dim oShell
iArgumentsCount = WScript.Arguments.Count
On Error Resume Next
For iArgument = 0 To iArgumentsCount
sFilePath = sFilePath & WScript.Arguments(iArgument)
Next
On Error GoTo 0
Set oFileScriptingObject = CreateObject("Scripting.FileSystemObject")
With oFileScriptingObject
sFileName = .GetFileName(sFilePath)
sTempFolder = oFileScriptingObject.GetSpecialFolder(2) 'Temp Folder
If .GetExtensionName(sFileName) = "xdw" Then
.CopyFile sFilePath, sTempFolder & "\", True 'Overwrite
Set oShell = CreateObject("Shell.Application")
oShell.Open sTempFolder & "\" & sFileName
Else
MsgBox "Please select a DocuWorks file.（.xdw)", vbCritical, sTitle
End If
End With
Set oFileScriptingObject = Nothing
Set oShell = Nothing
End Sub
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
can any one help me to add all the drives of my computer in tree view..
Dim fs As New FileSystemObject
Private Sub Form_Load()
Dim path As String
path = "D:\MP3"
TreeView1.Nodes.Add , , path, path
Call addtotree(path, TreeView1)
End Sub
Private Sub addtotree(path As String, tv As TreeView)
Dim folder1 As Folder
For Each folder1 In fs.GetFolder(path).SubFolders
tv.Nodes.Add path, tvwChild, path & "\" & folder1.Name, folder1.Name
Call addtotree(path & "\" & folder1.Name, tv)
Next
End Sub
i am doing like this to add nodes and sub nodes but i don't know how to add dynamically all the drives and folder like window explorer.
I'm not sure from your code sample what you're trying to do. If you want to add the drives to your treeview iterate the FileSystemObject.Drives collection. If you are trying to populate the folders under the drives, get the drives, and as the user expands them find the folders under them. Here is a sample that gets drives.
Option Explicit
Private Const EXPANDING = " (expanding...)"
Private Sub LoadDrives(ByVal TreeviewCtrl As TreeView)
Dim objFso As FileSystemObject
Dim objDrive As Drive
Dim objNode As MSComctlLib.Node
On Error GoTo errLoadDrives
Me.MousePointer = vbHourglass
TreeviewCtrl.Nodes.Clear
Set objFso = New FileSystemObject
For Each objDrive In objFso.Drives
Set objNode = TreeView1.Nodes.Add(, tvwFirst, objDrive.Path, objDrive.Path & "\" & IIf(Len(objDrive.ShareName) > 0, " (" & Replace$(objDrive.ShareName, "\\", "") & ")", ""))
If objDrive.IsReady Then
If objDrive.RootFolder.SubFolders.Count > 0 Then
TreeviewCtrl.Nodes.Add objNode, tvwChild
End If
End If
Next objDrive
Me.MousePointer = vbDefault
Exit Sub
errLoadDrives:
Set objFso = Nothing
Me.MousePointer = vbDefault
End Sub
Private Sub TreeView1_Expand(ByVal Node As MSComctlLib.Node)
On Error GoTo errTreeView1_Expand
Me.MousePointer = vbHourglass
Node.Text = Node.Text & EXPANDING ' user feedback for longer operations
TreeView1.Refresh
Call AddToTree(Node)
Node.Text = Replace$(Node.Text, EXPANDING, "")
Me.MousePointer = vbDefault
Exit Sub
errTreeView1_Expand:
Me.MousePointer = vbDefault
MsgBox "There was an error getting the child folders." & vbCrLf & vbCrLf & "Error " & CStr(Err.Number) & ", " & Err.Description, vbOKOnly + vbCritical, Err.Source
End Sub
Private Sub AddToTree(ByVal Node As MSComctlLib.Node)
Dim strPath As String
Dim objParentNode As MSComctlLib.Node
Dim objFso As FileSystemObject
Dim objFolder As Folder
Dim objSubFolder As Folder
Dim objFile As File
Dim objNode As MSComctlLib.Node
On Error GoTo errAddToTree
' remove any place holder node
If Node.Child.Key = "" Then
TreeView1.Nodes.Remove Node.Child.Index
End If
strPath = Node.Key & "\" ' get the path of the current node
Set objFso = New FileSystemObject
Set objFolder = objFso.GetFolder(strPath)
For Each objSubFolder In objFolder.SubFolders
Set objNode = TreeView1.Nodes.Add(Node, tvwChild, objSubFolder.Path, objSubFolder.Name)
If objSubFolder.SubFolders.Count > 0 Or objSubFolder.Files.Count > 0 Then ' add an empty place holder node
TreeView1.Nodes.Add objNode, tvwChild
End If
Next objSubFolder
For Each objFile In objFolder.Files
TreeView1.Nodes.Add Node, tvwChild, Node.Key & "\" & objFile.Name, objFile.Name, "leaf"
Next objFile
Node.EnsureVisible
Exit Sub
errAddToTree:
If Err.Number = 70 Then 'permission denied - ignore it and move on
Resume Next
End If
End Sub
I am working on a project that requires me to search and list all files in a folder that could have multiple sub folders and write it to text documents.
Primarily the file extension i will be searching for is a .Doc, but I will need to list the other files found in said directory as well.
To make things slightly more difficult I want the text documents to be sorted by File type and another by Directory.
I do not know how possible this is, but I have search for methods online, but have as of yet found correct syntax.
Any help will be greatly appreciated.
I write this in the past, should server as a base for your version. I know it's not .NET, still I hope it helps something. It prompts the user for a path to scan, recurses into folders, and writes the file name, path, and owner into a CSV file. Probably really inefficient and slow, but does the job.
Main() ' trickster yo
Dim rootFolder 'As String
Dim FSO 'As Object
Dim ObjOutFile
Dim objWMIService 'As Object
Sub Main()
StartTime = Timer()
If Wscript.Arguments.Count = 1 Then ' if path provided with the argument, use it.
rootFolder = Wscript.Arguments.Item(0)
Else
rootFolder = InputBox("Give me the search path : ") ' if not, ask for it
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
Set ObjOutFile = FSO.CreateTextFile("OutputFiles.csv")
Set objWMIService = GetObject("winmgmts:")
ObjOutFile.WriteLine ("Path, Owner") ' set headers
Gather (rootFolder)
ObjOutFile.Close ' close the stream
EndTime = Timer()
MsgBox ("Done. (ran for " & FormatNumber(EndTime - StartTime, 2) & "s.)")
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function Gather(FolderName)
On Error Resume Next
Dim ObjFolder
Dim ObjSubFolders
Dim ObjSubFolder
Dim ObjFiles
Dim ObjFile
Set ObjFolder = FSO.GetFolder(FolderName)
Set ObjFiles = ObjFolder.Files
For Each ObjFile In ObjFiles 'Write all files to output files
Set objFileSecuritySettings = _
objWMIService.Get("Win32_LogicalFileSecuritySetting='" & ObjFile.Path & "'")
intRetVal = objFileSecuritySettings.GetSecurityDescriptor(objSD)
If intRetVal = 0 Then
owner = objSD.owner.Domain & "\" & objSD.owner.Name
ObjOutFile.WriteLine (ObjFile.Path & ";" & owner) ' write in CSV format
End If
Next
Set ObjSubFolders = ObjFolder.SubFolders 'Getting all subfolders
For Each ObjFolder In ObjSubFolders
Set objFolderSecuritySettings = _
objWMIService.Get("Win32_LogicalFileSecuritySetting='" & ObjFile.Path & "'")
intRetVal = objFolderSecuritySettings.GetSecurityDescriptor(objSD)
If intRetVal = 0 Then
owner = objSD.owner.Domain & "\" & objSD.owner.Name
ObjOutFile.WriteLine (ObjFolder.Path & ";" & owner) ' write in CSV format
End If
Gather (ObjFolder.Path)
Next
End Function
In this script I try to rename all the files within a folder. The new names I will gather from each textfiles in itself using Instr(1, strText, "(Amtlicher Gemeindeschlüssel = " ...). So all jsp-files shall be proceed. But I get an object-error almost at the end: 800A01A8 - Object Required. Can anyone helpme to replace the object strVerz.files so the the code works.
Thank U in advance.
Michael
Dim objFso, strFolder
' Begin Main
Set objFso = CreateObject("Scripting.FileSystemObject")
strFolder = objFso.GetParentFolderName(WScript.ScriptFullName)
If objFso.FolderExists(strFolder) Then
Call GetJspFiles(objFso.GetFolder(strFolder))
End If
Set objFso = Nothing
' End Main
Sub GetJspFiles(ByRef objFolder)
Dim objFile, objSubFolder
For Each objFile In objFolder.Files
If LCase(objFso.GetExtensionName(objFile.Name)) = "jsp" Then
Call JSPRename(objFile.Path, objFolder.Path)
End If
Next
For Each objSubFolder In objFolder.SubFolders
Call GetJspFiles(objSubFolder)
Next
' objFile.Close
End Sub
Sub JSPRename(ByRef strPath, ByRef strFolder)
Dim arrText, strText, strTextLine, Position , objJspFile, newFilename, strVerz
Set objJspFile = objFso.OpenTextFile(strPath)
arrText = Split(objJspFile.ReadAll, vbCrLf) ' split to lines
For Each strTextLine In arrText
If strTextLine <> "" Then
strText = Trim(strTextLine)
If Instr(1,strText,"(Amtlicher Gemeindeschlüssel",1) Then
Position=Instr(1, strText, "(Amtlicher Gemeindeschlüssel =",1)
newFilename=mid(strText,Position+31, 8)
else
end if
end if
Next
strVerz=objFSO.GetParentFoldername(WScript.ScriptFullName)
strNewName = strVerz & "\" & newFilename & ".jsp"
' Wscript.echo strNewName & vbcrlf & strVerz.files '!! only for Showing the results
objFSO.MoveFile strVerz.files, strNewName <- Here I get the error
objJspFile.Close
End Sub
It seems like the purpose of JSPRename is to rename the file given by strPath. In that case, the call to MoveFile should look like:
objFSO.MoveFile strPath, strNewName