I have some code that should take a starting directory and loop through that and all subdirectories but instead it's getting to the last subdirectory in the first branch it goes down and exits out. I know there are a bunch of these, but I can't figure out how to get past the last subdirectory. I was hoping someone could point out how to continue on through the next directory branch. (It's just checking for files older than 1 hour and emailing me and that part works fine, it just doesn't look everywhere).
Sub Main()
Dim dirList As New String("C:\Users\Test\SampleDir")
Dim lOldNames = New List(Of String)()
ListFiles(dirList, lOldNames)
If lOldNames.Count > 0 Then
sendMail(lOldNames)
End If
End Sub
Public Function ListFiles(ByVal sdirList As String, ByVal lOldNames As List(Of String))
Dim dirList As New DirectoryInfo(sdirList)
Dim fiFileList As FileInfo() = dirList.GetFiles()
Dim fiName As FileInfo
Dim bEmpty As Boolean = False
bEmpty = IsDirectoryEmpty(dirList.ToString)
If bEmpty = False Then
For Each fiName In fiFileList
If fiName.CreationTime.AddHours(1) < DateTime.Now Then
lOldNames.Add(fiName.FullName)
End If
Next fiName
End If
Dim subDirs() As DirectoryInfo = dirList.GetDirectories()
For Each subdir As DirectoryInfo In subDirs
ListFiles(subdir.FullName, lOldNames)
Next subdir
Return lOldNames
End Function
'Function to test if directory is empty
Public Function IsDirectoryEmpty(ByVal path As String) As Boolean
Return Not (Directory.EnumerateFileSystemEntries(path).Any())
End Function
Fixed and shortened the function call per Steve's comment below:
Public Function ListFiles(ByVal sdirList As String, ByVal lOldNames As List(Of String))
Dim dirList As New DirectoryInfo(sdirList)
Dim fiFileList As FileInfo() = dirList.GetFiles()
Dim dirs As String() = Directory.GetFiles(sdirList, "*", SearchOption.AllDirectories)
For Each sfile As String In dirs
If Not sfile.Contains("Software") AndAlso Not sfile.Contains("Outbound") AndAlso Not sfile.Contains("RECYCLE.BIN") AndAlso Not sfile.Contains("System Volume") Then
Dim fiName As New FileInfo(sfile)
If fiName.CreationTime.AddHours(1) < DateTime.Now Then
lOldNames.Add(fiName.FullName)
End If
End If
Next
Return lOldNames
End Function
Related
I've been searching the net and have found a lot of posts about copying files, but I haven't had luck with copying files in subfolders. What I want to do is give a sourcePath, and a destinationPath. All files (including the ones in subfolders) will get copied into the destinatioPath. I've fiddled with lots of code but I haven't been able to get the search for subfolder to work.
Code I tried: but gives me an error on "dest" in the file copy line.
Public Sub CopyAllFiles(ByVal sourcePath As String, ByVal destPath As String)
Dim files() As String = IO.Directory.GetFiles(destPath)
For Each file As String In files
' Do work, example
Dim dest As String = Path.Combine(destPath, Path.GetFileName(file))
file.Copy(file, dest, True) ' Added True here to force the an overwrite
Next
End Sub
Code I tried but it moves the subfolder over to the desinationPath
Public Sub CopyDirectory(ByVal sourcePath As String, ByVal destinationPath As String)
Dim sourceDirectoryInfo As New System.IO.DirectoryInfo(sourcePath)
' If the destination folder don't exist then create it
If Not System.IO.Directory.Exists(destinationPath) Then
System.IO.Directory.CreateDirectory(destinationPath)
End If
Dim fileSystemInfo As System.IO.FileSystemInfo
For Each fileSystemInfo In sourceDirectoryInfo.GetFileSystemInfos
Dim destinationFileName As String =
System.IO.Path.Combine(destinationPath, fileSystemInfo.Name)
' Now check whether its a file or a folder and take action accordingly
If TypeOf fileSystemInfo Is System.IO.FileInfo Then
System.IO.File.Copy(fileSystemInfo.FullName, destinationFileName, True)
Else
' Recursively call the mothod to copy all the neste folders
CopyDirectory(fileSystemInfo.FullName, destinationFileName)
End If
Next
End Sub
I also tried this code buy it didn't give the files in the subfolders
Private Function CopyDirectory(sourcedir As String, targetdir As String, overwrite As Boolean) As List(Of String)
Dim failedCopy As List(Of String) = New List(Of String)
Directory.CreateDirectory(targetdir)
Dim files = Directory.GetFiles(sourcedir, "*.*", SearchOption.AllDirectories)
For Each file In files
Dim newfile = file.Replace(sourcedir, targetdir)
Dim fi = New FileInfo(file)
Try
fi.CopyTo(newfile, overwrite)
Catch ex As Exception
failedCopy.Add(file)
End Try
Next
Return failedCopy
End Function
This should get you fairly close
Private Sub DirTestCopyButton_Click(sender As Object, e As EventArgs) Handles DirTestCopyButton.Click
Try
CopyDirectoryContents("c:\temp\", "c:\out")
MessageBox.Show("Copy complete")
Catch ex As Exception
MessageBox.Show(String.Concat("An error occurred: ", ex.Message))
End Try
End Sub
Private Sub CopyDirectoryContents(sourcePath As String, destinationPath As String)
If Not Directory.Exists(sourcePath) Then
Return
End If
If Not Directory.Exists(destinationPath) Then
Directory.CreateDirectory(destinationPath)
End If
For Each filePathString As String In Directory.GetFiles(sourcePath, "*.*", SearchOption.AllDirectories)
Dim fileInfoItem As New FileInfo(filePathString)
Dim newFilePath As String = Path.Combine(destinationPath, fileInfoItem.Name)
If File.Exists(newFilePath) Then
'do something about this
Else
File.Copy(filePathString, newFilePath)
End If
Next
End Sub
I am trying to import a large CSV file, where I am dumping each row of the input csv file into an array (vector), which is NumColumns long. I fetched some code to copy a list to a DataTable, however, I am not sure the IList (IsEnumerable?) is needed. I also haven't looked into what T is.
My gut feeling is that I can go to some other code I have to load a DataTable with row and column data from a 2-dimensional array x(,), but for some reason I think there may be a fast way to simply .add(x), i.e. add the entire row vector to the DataTable to keep the speed up. You don't want to loop through columns(?)
Below is the code which will open up any .csv.
Imports System.ComponentModel
Imports System.IO
Public Class Form1
Dim NumColumns As Integer
Dim ColumnNames() As String
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim filename As String = Nothing
With OpenFileDialog1
.FileName = "*.csv"
.CheckFileExists = True
.ShowReadOnly = True
.Filter = "Comma delimited *.csv|*.csv"
If .ShowDialog = DialogResult.OK Then
filename = .FileName
End If
End With
Dim csvreader As New StreamReader(filename)
Dim inputLine As String = ""
inputLine = csvreader.ReadLine()
Dim buff() As String = Split(inputLine, ",")
NumColumns = UBound(buff)
ReDim ColumnNames(UBound(buff) + 1)
For j As Integer = 0 To NumColumns
ColumnNames(j + 1) = buff(j)
Next
inputLine = csvreader.ReadLine()
Do While inputLine IsNot Nothing
Dim rowdata = New MyDataArray(NumColumns)
Dim csvArray() As String = Split(inputLine, ",")
For i As Integer = 0 To NumColumns
rowdata.x(i) = csvArray(i)
Next
MyDataArray.DataArray.Add(rowdata)
inputLine = csvreader.ReadLine()
Loop
Dim dgv As New DataGridView
dgv.DataSource = ToDataTable(MyDataArray.DataArray)
dgv.Width = 1000
dgv.Height = 1000
Me.Controls.Add(dgv)
End Sub
Public Shared Function ToDataTable(Of T)(data As IList(Of T)) As DataTable
Dim properties As PropertyDescriptorCollection = TypeDescriptor.GetProperties(GetType(T))
Dim dt As New DataTable()
For i As Integer = 0 To properties.Count - 1
Dim [property] As PropertyDescriptor = properties(i)
dt.Columns.Add([property].Name, [property].PropertyType)
Next
Dim values As Object() = New Object(properties.Count - 1) {}
For Each item As T In data
For i As Integer = 0 To values.Length - 1
values(i) = properties(i).GetValue(item)
Next
dt.Rows.Add(values(1))
Next
Return dt
End Function
End Class
Public Class MyDataArray
Public Shared DataArray As New List(Of MyDataArray)()
Public Property x() As Object
Sub New(ByVal cols As Integer)
ReDim x(cols)
End Sub
End Class
Maybe this code will help?
You can use OleDB to convert the CSV to a Database and then put it into a datatable. All you need is a DataGridView and form (If you want to print it). Then you can use teh code below to accomplish what you need to do.
Public Class Form1
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
Dim file As String = "test.txt"
Dim path As String = "C:\Test\"
Dim ds As New DataSet
Try
If IO.File.Exists(IO.Path.Combine(path, file)) Then
Dim ConStr As String = _
"Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
path & ";Extended Properties=""Text;HDR=No;FMT=Delimited\"""
Dim conn As New OleDb.OleDbConnection(ConStr)
Dim da As New OleDb.OleDbDataAdapter("Select * from " & _
file, conn)
da.Fill(ds, "TextFile")
End If
Catch ex As Exception
MessageBox.Show(ex.ToString)
End Try
DataGridView1.DataSource = ds.Tables(0)
End Sub
End Class
However, you could always convert it to an xml and work from there
Imports System.IO
Module Module3
Public Function _simpleCSV2tbl(CSVfile As String) As DataTable
Dim watch As Stopwatch = Stopwatch.StartNew()
watch.Start()
'A,B,C,D,E
'00001,4,1,2,3560
'00002,4,12,1,2000
'00003,1,4,2,4500
'00004,4,12,1,2538.63
'00005,1,1,2,3400
'00006,2,5,2,2996.48
Dim dTable As New DataTable(CSVfile)
Using reader As New StreamReader(CSVfile)
Dim CSV1stLine As String = reader.ReadLine
Dim getCols = (From s In CSV1stLine.Split(",") Select s).ToList()
Dim setTblColumns = (From c In getCols Select dTable.Columns.Add(c, GetType(String))).ToList
Dim ReadToEnd As String = reader.ReadToEnd()
Dim getRows = (From s In ReadToEnd.Split(vbLf) Select s).ToArray
_setTblRows(getRows, dTable)
Console.WriteLine(String.Format("Elapsed: {0}", Format(watch.Elapsed.TotalMilliseconds, "F"), dTable.Rows.Count))
reader.Close()
reader.Dispose()
End Using
_ShowTbl(dTable, 10)
End Function
Public Function _setTblRows(getRows As String(), dTable As DataTable) As IEnumerable
_setTblRows = getRows.Select(Function(r) dTable.LoadDataRow(r.Split(","), False)).ToArray()
End Function
Public Sub _ShowTbl(ByVal dTable As DataTable, Optional ByVal rPad As Short = 0)
If dTable.TableName = Nothing Then dTable.TableName = "NoName"
If rPad = 0 Then
Console.WriteLine(String.Format("->Unformatted Table: {0}, Count={1}", dTable.TableName, dTable.Rows.Count))
Else
Console.WriteLine(String.Format("->Formatted Table: {0}, Count={1}", dTable.TableName, dTable.Rows.Count))
End If
_ShowTblColumns(dTable.Columns, rPad)
_ShowTblRows(dTable.Rows, rPad)
End Sub
Public Function _ShowTblColumns(ByVal TblColumns As DataColumnCollection, Optional ByVal rPad As Short = 0)
Dim getTblColumns = (From c As DataColumn In TblColumns Select c.ColumnName).ToList()
Console.WriteLine(String.Join(",", getTblColumns.Select(Function(s) String.Format(s.PadLeft(rPad, vbNullChar)).ToString).ToArray))
End Function
Public Function _ShowTblRow(ByVal Row As DataRow, Optional ByVal rPad As Short = 0)
Dim getRowFields = (From r In Row.ItemArray Select r).ToList
Console.WriteLine(String.Join(",", getRowFields.Select(Function(s) String.Format(s.PadLeft(rPad, vbNullChar)).ToString).ToArray))
End Function
Public Function _ShowTblRows(ByVal Rows As DataRowCollection, Optional ByVal rPad As Short = 0)
Dim rCount As Integer
For Each row As DataRow In Rows
_ShowTblRow(row, rPad)
rCount += 1
If rCount Mod 20 = 0 Then
If NewEscape(String.Format(" {0} out of {1}", rCount.ToString, (Rows.Count).ToString)) Then Exit Function
End If
Next row
Console.WriteLine()
End Function
Public Function _NewEscape(ByVal Message As String) As Boolean
Console.Write("{0} / Press any key to continue or Esc to quit {1}", Message, vbCrLf)
Dim rChar As Char = Console.ReadKey(True).KeyChar
Dim rEscape As Boolean
If rChar = Chr(27) Then rEscape = True
Return rEscape
End Function
End Module
As you can see here I block the directory called "cleo". If I have it in my folder I can't click connect. How can I check if, for example, "Cleo", "Images", "Logs" exist in browsed file. I don't think making multiple If statements would be good, is there any other way?
Private Sub connect_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles connect.Click
Dim cleoPath As String
Dim filePath As String
filePath = System.IO.Path.Combine(TextBox2.Text, "gta_sa.exe")
cleoPath = System.IO.Path.Combine(TextBox2.Text, "cleo")
If File.Exists(filePath) Then
If Directory.Exists(cleoPath) Then
MsgBox("Pronasli smo cleo fajl u vasem GTA root folderu. Da se konektujete na server morate ga obrisati.")
Else
Dim p() As Process
p = Process.GetProcessesByName("samp")
If p.Count > 0 Then
MsgBox("Vec imate pokrenut SAMP - ugasite ga.")
Else
Try
Dim prozess As Process = Process.GetProcessesByName("samp")(0)
prozess.Kill()
Catch ex As Exception
End Try
My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\SAMP", "PlayerName", TextBox1.Text)
Process.Start("samp://193.192.58.55:7782")
Dim client As New TcpClient
client.Connect("193.192.58.55", 10924)
Dim sendbytes() As Byte = System.Text.Encoding.ASCII.GetBytes(TextBox1.Text)
Dim stream As NetworkStream = client.GetStream()
stream.Write(sendbytes, 0, sendbytes.Length)
End If
End If
Else
MsgBox("Da se konektujete morate locirati GTA San Andreas folder.")
End If
End Sub
End Class
You could use extension methods combined with a directoryinfo to check if any of a list of directory exists. Depending of if you just want a true/false return or if you need to process each directories (for instance, by adding a custom message with the name of the folders that prevent your application from continuing.
Public Module DirectoryInfoExt
<System.Runtime.CompilerServices.Extension()>
Public Function AnyExists(DirInfo As IO.DirectoryInfo, ParamArray Directories As String()) As Boolean
Dim MyPath As String = DirInfo.FullName.TrimEnd("\"c) & "\"
Return Directories.Any(Function(Dir) IO.Directory.Exists(MyPath & Dir))
End Function
<System.Runtime.CompilerServices.Extension()>
Public Function GetExistingDirectories(DirInfo As IO.DirectoryInfo, ParamArray Directories As String()) As IEnumerable(Of String)
Dim MyPath As String = DirInfo.FullName.TrimEnd("\"c) & "\"
Return Directories.Where(Function(Dir) IO.Directory.Exists(MyPath & Dir))
End Function
End Module
An example the boolean return.
Dim BaseDirectory As String = "C:\Games\GTA"
Dim GamePath As New DirectoryInfo(BaseDirectory)
' Will not give the specific path that exists, only a Boolean if any of theses folder are found
Dim ModsFound As Boolean = GamePath.AnyExists("Images", "Cleo", "Logs", "SomeFolder\Subfolder")
If Not ModsFound Then
'Connect
Else
' Do something
End If
An example using the list return to generate a custome message prompt stating the name of the specific folders found.
'This version gives a list instead.
Dim ModsFoundList As IEnumerable(Of String) = GamePath.GetExistingDirectories("Images", "Cleo", "Logs", "SomeFolder\Subfolder")
Dim HasMod As Boolean = ModsFoundList.Count > 0
If HasMod Then
EvilModdedUserPrompt(ModsFoundList)
Exit Sub
End If
' Here, since HasMod is false, we can proceed with connection.
' Do connection
As for the EvilModdedUserPrompt method
Public Sub EvilModdedUserPrompt(ModsFoundList As List(Of String))
Dim OutputMessage As New Text.StringBuilder
OutputMessage.AppendLine("The following mods have been detected on your system:")
For Each Moditem As String In ModsFoundList
OutputMessage.AppendFormat("- {0}", Moditem)
OutputMessage.AppendLine()
Next
MessageBox.Show(OutputMessage.ToString)
End Sub
I am trying to figure out the code on Visual Basic after I have already extracted all files from a folder that was in a flash drive and put them in a folder on the computer. How could I have this program delete all the files that have not been modified from a previous date in the folder on the computer?
This is what I have so far:
Imports System.IO
Public Class frmExtractionator
Private Sub btnStart_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles btnStart.Click
Dim sourceDirectory As String = "E:\CopierFolderforTestDriveCapstone"
Dim archiveDirectory As String = "E:\FilesExtracted"
Try
Dim txtFiles = Directory.EnumerateFiles(sourceDirectory)
If(Not System.IO.Directory.Exists(archiveDirectory )) Then
System.IO.Directory.CreateDirectory(archiveDirectory)
End If
For Each currentFile As String In txtFiles
Dim fileName = currentFile.Substring(sourceDirectory.Length + 1)
File.Move(currentFile, Path.Combine(archiveDirectory, fileName))
Next
Catch eT As Exception
Console.WriteLine(eT.Message)
End Try
End Sub
End Class
Something like this will delete files that have not been modified since the given date.
Private Sub DeleteUnmodifiedFiles(directoryName As String, modificationThreshold As Date)
Dim folder As New DirectoryInfo(directoryName)
Dim wasModifiedSinceThreshold As Boolean
For Each file As FileInfo In folder.GetFiles
wasModifiedSinceThreshold = (file.LastWriteTime > modificationThreshold)
If (Not wasModifiedSinceThreshold) Then file.Delete()
Next
End Sub
To delete based on a number of days...
Private Sub DeleteUnmodifiedFiles(directoryName As String, modificationThresholdDays As Integer)
Dim folder As New DirectoryInfo(directoryName)
Dim thresholdDate As Date
Dim wasModifiedSinceThreshold As Boolean
For Each file As FileInfo In folder.GetFiles
thresholdDate = DateTime.Now().AddDays(-1 * modificationThresholdDays)
wasModifiedSinceThreshold = (file.LastWriteTime > thresholdDate)
If (Not wasModifiedSinceThreshold) Then file.Delete()
Next
End Sub
Here Is my code
Public Sub MoveAllFolders(ByVal fromPathInfo As DirectoryInfo, ByVal toPath As String)
Dim toPathInfo = New DirectoryInfo(toPath)
If (Not toPathInfo.Exists) Then
toPathInfo.Create()
End If
'move all folders
For Each dir As DirectoryInfo In fromPathInfo.GetDirectories()
dir.MoveTo(Path.Combine(toPath, dir.Name))
Next
End Sub
MoveAllFolders("D:\Users\TheUser!\Desktop\dd", "D:\Users\TheUser!\Desktop\dd\Folders)
My goal is to move all folder inside a folder into a folder named Folders.
so If I do it on desktop all the folders in desktop will go to "Folders"
but I get an error "The process cannot access the file because it is being used by another process."
so this code can't work this way, so is there any way to do what I wanna do?
Thanks alot!
You are moving your target-directoy into itself.
You could check if the destination-path contains the source-directory's FullName.
If Not toPath.Contains(fromPathInfo.FullName) Then
dir.MoveTo(IO.Path.Combine(toPath, dir.Name))
End If
But this method would be quite hacky. Consider a folder '"D:\abc1' and a folder '"D:\abc2'. Contains would return true in this case even if the folder "abc1" and "abc2" are not the same.
This should work better:
Public Sub MoveAllFolders(ByVal fromDir As IO.DirectoryInfo, ByVal toDir As IO.DirectoryInfo, Optional ByVal excludeList As List(Of String) = Nothing)
If (Not toDir.Exists) Then
toDir.Create()
End If
'move all folders
For Each dir As IO.DirectoryInfo In fromDir.GetDirectories()
Dim targetPath = IO.Path.Combine(toDir.FullName, dir.Name)
If Not toDir.FullName = dir.FullName _
AndAlso Not IsParentDirectory(toDir, dir) _
AndAlso Not IO.Directory.Exists(targetPath) _
AndAlso (excludeList Is Nothing _
OrElse Not excludeList.Contains(dir.FullName, StringComparer.InvariantCultureIgnoreCase)) Then
Try
dir.MoveTo(targetPath)
Catch ioEx As IO.IOException
'ignore this directory'
Catch authEx As UnauthorizedAccessException
'ignore this directory'
Catch ex As Exception
Throw
End Try
End If
Next
End Sub
Public Shared Function IsParentDirectory(ByVal subDir As IO.DirectoryInfo, ByVal parentDir As IO.DirectoryInfo) As Boolean
Dim isParent As Boolean = False
While subDir.Parent IsNot Nothing
If subDir.Parent.FullName = parentDir.FullName Then
isParent = True
Exit While
Else
subDir = subDir.Parent
End If
End While
Return isParent
End Function
You could use this function in this way:
Dim excludePathList As New List(Of String)
excludePathList.Add("C:\Temp\DoNotMoveMe1\")
excludePathList.Add("C:\Temp\DoNotMoveMe2\")
MoveAllFolders(New IO.DirectoryInfo("C:\Temp\"), New IO.DirectoryInfo("C:\Temp\temp-sub\"), excludePathList)
Edit: updated according to your last comment (untested).