Senior Member
Registrato: 30-09-2003
Loc.: Genova
Messaggi: 274
|
Rif: [Visual Studio 2010 Express] Programmino per rinominare file
Questo è il tabulato che ho tirato giù:
Module Module1
Sub Main()
Dim file
Dim NuovoNome
'Loop through each file in the folder
For Each file In My.Computer.FileSystem.GetFiles("C:\Users\zilli\De sktop\POSTA\", FileIO.SearchOption.SearchAllSubDirectories)
If file.contains(".eml") = False Then
My.Computer.FileSystem.DeleteFile(file)
ElseIf file.Contains("[Subj]") Then
Else
'leggi righe da file
Dim sr As IO.StreamReader = IO.File.OpenText(file)
Dim testlinea As String
Dim Data As String = 0
Dim Oratrim As String = 0
Dim Datatrim(0 To 2) As String
Dim Soggetto As String = 0
Do
testlinea = sr.ReadLine()
If testlinea.Contains("Subject: ") Then
Soggetto = testlinea
ElseIf testlinea.Contains("Date: ") Then
Data = testlinea
End If
Loop Until Data <> "0" And Soggetto <> "0"
'eliminare caratteri non consentiti e modificare il SOGGETTO
Soggetto = Replace(Soggetto, "Subject: ", "[Subj]")
Soggetto = Replace(Soggetto, ":", "_")
Soggetto = Replace(Soggetto, "\", "_")
Soggetto = Replace(Soggetto, "/", "_")
Soggetto = Replace(Soggetto, ">", "_")
Soggetto = Replace(Soggetto, "<", "_")
Soggetto = Replace(Soggetto, "?", "_")
Soggetto = Replace(Soggetto, "*", "_")
Soggetto = Replace(Soggetto, "|", "_")
Soggetto = Replace(Soggetto, "*** SPAM ***", "SPAM")
Soggetto = Replace(Soggetto, vbTab, " ")
Soggetto = Replace(Soggetto, Chr(34), "''")
'eliminare caratteri non consentiti e modificare la DATA
Data = Right(Data, 26)
Data = Left(Data, 20)
Data = Replace(Data, ":", ".")
Data = Replace(Data, " Jan ", "-01-")
Data = Replace(Data, " Feb ", "-02-")
Data = Replace(Data, " Mar ", "-03-")
Data = Replace(Data, " Apr ", "-04-")
Data = Replace(Data, " May ", "-05-")
Data = Replace(Data, " Jun ", "-06-")
Data = Replace(Data, " Jul ", "-07-")
Data = Replace(Data, " Aug ", "-08-")
Data = Replace(Data, " Sep ", "-09-")
Data = Replace(Data, " Oct ", "-10-")
Data = Replace(Data, " Nov ", "-11-")
Data = Replace(Data, " Dec ", "-12-")
If Left(Data, 1) = " " Then
Data = LTrim(Data)
Data = "0" & Data
End If
Oratrim = Right(Data, 8)
'Data in formato internazionale
Datatrim(0) = Left(Data, 2)
Datatrim(1) = Left(Data, 5)
Datatrim(1) = Right(Datatrim(1), 2)
Datatrim(2) = Left(Data, 10)
Datatrim(2) = Right(Datatrim(2), 4)
Data = Datatrim(2) & "-" & Datatrim(1) & "-" & Datatrim(0)
NuovoNome = Data & " " & Oratrim & " " & Soggetto & ".eml"
'Chiude lettura del file
sr.Close()
'Rinominare file
If My.Computer.FileSystem.FileExists(NuovoNome) = False Then
My.Computer.FileSystem.RenameFile(file, NuovoNome)
Else
Resume Next
End If
End If
Next
End Sub
End Module
|