I got the code to zip the files in the directory. Here it is
Private Sub ZipFiles()
Dim zipPath As String = "C:\TEMP\Compression\myzip.zip"
'Open the zip file if it exists, else create a new one
Dim zip As Package = ZipPackage.Open(zipPath, _
IO.FileMode.OpenOrCreate, IO.FileAccess.ReadWrite)
'Add as many files as you like:
AddToArchive(zip, "C:\TEMP\Compression\Compress Me1.txt")
AddToArchive(zip, "C:\TEMP\Compression\Compress Me2.txt")
AddToArchive(zip, "C:\TEMP\Compression\Compress Me3.txt")
zip.Close() 'Close the zip file
End Sub
Private Sub AddToArchive(ByVal zip As Package, _
ByVal fileToAdd As String)
'Replace spaces with an underscore (_)
Dim uriFileName As String = fileToAdd.Replace(" ", "_")
'A Uri always starts with a forward slash "/"
Dim zipUri As String = String.Concat("/", _
IO.Path.GetFileName(uriFileName))
Dim partUri As New Uri(zipUri, UriKind.Relative)
Dim contentType As String = _
Net.Mime.MediaTypeNames.Application.Zip
'The PackagePart contains the information:
' Where to extract the file when it's extracted (partUri)
' The type of content stream (MIME type): (contentType)
' The type of compression: (CompressionOption.Normal)
Dim pkgPart As PackagePart = zip.CreatePart(partUri, _
contentType, CompressionOption.Normal)
'Read all of the bytes from the file to add to the zip file
Dim bites As Byte() = File.ReadAllBytes(fileToAdd)
'Compress and write the bytes to the zip file
pkgPart.GetStream().Write(bites, 0, bites.Length)
End Sub
But this code is creating problem when the file is already present in the zipped folder. It gives an exception. How can i overwrite the files which are already present ?
Also, this code is little slow, is there any fast way to zip the files ?
Try this
'Open the zip file if it exists, else create a new one
Dim zip As Package = ZipPackage.Open(zipPath, _
IO.FileMode.Create, IO.FileAccess.ReadWrite, IO.FileShare.Read)
Related
I create a plugin for MS Word by VSTO VB.NET
I Wrote the function to copy two files to the AppData folder from Resources.
The code works fine and copy files, but create the Additional files (file size is 0) in MyDocumnet and my doc file location.
How can I fix it?
Public Function openFile(fName As String) As String
Dim path, fileName As String
Dim bytes, p
' Dim FileLocked As Boolean
p = Environment.GetEnvironmentVariable("APPDATA") & "\"
Select Case fName
Case "q"
bytes = My.Resources.qText
fileName = "qText.docx"
path = p & fileName
Case "t"
bytes = My.Resources.tText
fileName = "tText.docx"
path = p & fileName
End Select
Dim Locked As Boolean = False
Try
Dim fs As FileStream = File.Open(fileName, FileMode.OpenOrCreate, FileAccess.ReadWrite, FileShare.None)
fs.Close()
Catch
Locked = True
End Try
Try
If Locked Then
Return fileName
Else
File.WriteAllBytes(path, bytes)
If fileName = "QText.docx" Then
SourceApp.Documents.Open(FileName:=path, ReadOnly:=True, Visible:=False)
Else
SourceApp.Documents.Open(FileName:=path, Visible:=False)
SourceApp.Documents("tText.docx").Content.Delete()
End If
SourceApp.ScreenUpdating = False
SourceApp.DisplayStatusBar = False
Call ComMode()
Return fileName
End If
Catch ex As Exception
End Try
End Function
When you check whether a particular file exists/locked on the disk a relative path is used. Only the filename is passed which means the relative path:
Dim fs As FileStream = File.Open(fileName, FileMode.OpenOrCreate, FileAccess.ReadWrite, FileShare.None)
fs.Close()
But when you write the content the absolute path is specified in the code:
File.WriteAllBytes(path, bytes)
The path can point to another place. I'd suggest using the Directory.GetCurrentDirectory method which gets the current working directory of the application. If required you may set the current directory using the Environment.CurrentDirectory property sets the fully qualified path of the current working directory.
Shouldn't this:
Dim fs As FileStream = File.Open(fileName, FileMode.OpenOrCreate, FileAccess.ReadWrite, FileShare.None)
actually be this:
Dim fs As FileStream = File.Open(path, FileMode.OpenOrCreate, FileAccess.ReadWrite, FileShare.None)
As it stands, you're specifying only a file name rather than a file path, so the folder path has to be assumed to be some default, which is presumably where you're seeing those files created.
This is an example of why descriptive variable names are important. Personally, I would have used folderPath, fileName and filePath rather than p, fileName and path. It's far more obvious what each one is then.
What's the point of creating a file anyway? Why not check whether one exists first and then only try to open it if it does? You appear to be checking whether the file is locked but it obviously can't be locked if it doesn't exist.
in my VB.net Application id like to overwrite and add new content of a text file
What Code do I need to use?
Thanks
Read (ie: load) everything in the TXT file into your program.
Dim sFullPathToFile As String = Application.StartupPath & "\Sample.txt"
Dim sAllText As String = ""
Using xStreamReader As StreamReader = New StreamReader(sFullPathToFile)
sAllText = xStreamReader.ReadToEnd
End Using
Dim arNames As String() = Split(sAllText, vbCrLf)
'Just for fun, display the found entries in a ListBox
For iNum As Integer = 0 To UBound(arNames)
If arNames(iNum) > "" Then lstPeople.Items.Add(arNames(iNum))
Next iNum
Because you wanted to overwrite everything in the file, we now use StreamWriter (not a StreamReader like before).
'Use the True to indicate it is to be appended to existing file
'Or use False to open the file in Overwrite mode
Dim xStreamWRITER As StreamWriter = New StreamWriter(sFullPathToFile, False)
'Use the carriage return character or else each entry is on the same line
xStreamWRITER.Write("I have overwritten everything!" & vbCrLf)
xStreamWRITER.Close()
Can anyone tell me how can I find say *.txt files inside a given folder inside which there are subfolders in the structure 12345\30123\128\txt\100.txt, the main folder can contain other subfolders or txt files but I only want to get the txt files which reside in the subfolders of the format 12345\30123\128\txt\100.txt. i.e. txt files inside all txt folders
I have tried this:
Dim txtFilesArray As String() = Directory.GetFiles(targetDirectory, "*.txt", SearchOption.AllDirectories)
But it gets all txt files?
Dim txtFiles = Directory.EnumerateFiles(targetDirectory,"*.txt",SearchOption.AllDirectories)
.Where(Function(f) f Like "*\#*\#*\#*\txt\#*.txt")
where # matches any digit from 0 to 9 and * matches any 0 or more characters
or slower RegEx version will be something like
Dim txtFiles = Directory.EnumerateFiles(targetDirectory,"*.txt",SearchOption.AllDirectories)
.Where(Function(f) RegEx.IsMatch(f, ".*\\\d+\\\d+\\\d+\\txt\\\\d+\.txt"))
For Each txtFile In txtFiles
'...
Next
This will return all files but those contained at path:
Dim path = "C:\"
Dim di As New DirectoryInfo(path)
Dim files = di _
.GetFiles("*.txt", SearchOption.AllDirectories) _
.Where(Function(info) info.DirectoryName <> path) _
.Select(function(info) info.FullName) _
.ToArray()
This searches for the end of a file name removes it's current file type of .docm and converts it to a .docx. Works great.
ActiveDocument.SaveAs2 Left(ActiveDocument.Name, InStrRev(ActiveDocument.Name, ".") - 1), WdSaveFormat.wdFormatXMLDocument
However, I noticed a little bug. If there is a . in the file name, it finds that first and obviously creates a file that is incorrect.
For example:
TestFileV1.2AlexTest.docm
Becomes the file
TestFileV.2AlextTest Where the new file type is a .2ALEXTEST file.
Kind of a funny error, but still a bug none the less.
Best course of action for validation?
Thanks!
Try the VBA.Strings.Split() function, which splits a string into an array.
Split the File name on '.' and the last element in the array will be your extension:
Public Function GetExtension(FileName As String) As String
'Returns a file's extension
' This does not go to the filesystem and get the file:
' The function parses out the string after the last '.'
' Useful for situations where a file does not yet exist
' Nigel Heffernan Excellerando.Blogspot.com
' **** THIS CODE IS IN THE PUBLIC DOMAIN ****
'Print GetExtension("C:\Temp\data.txt1.docx")
'Returns docx
Dim arrayX() As String
Dim iLast As Integer
arrayX = Split(FileName, ".")
iLast = UBound(arrayX)
GetExtension = arrayX(iLast)
Erase arrayX
End Function
If you don't care about readability, the quick-and-dirty answer is:
strExt = Split(strFile, ".")(UBound(Split(strFile, ".")))
However... I think you're looking for something more sophisticated than a string parser to extract the file extension.
Are you actually looking to validate the file extension?
I'm not coding up a registry lookup for the ShellExt application command to open your file, but I had a closely-related issue to yours a year or two ago, when I needed to populate a file dialog's filter list with a list of arbitrary file extensions.
It doesn't 'validate' as such, but unknown extensions will return a string containing 'unknown file type', and you can test for that:
VBA and the Registry: Returning a File Type from a File Extension
Public Function GetExtensionType(strExt As String) As String
' Return a file extension type descriptor, if the OS knows it
' Parses out the string after the last "." and reads the registry
' GetExtensionType("txt") Returns 'Text Document'
' GetExtensionType("SystemORA.user.config") 'XML Configuration File'
' GetExtensionType("Phishy.vbs") 'VBScript Script File'
' Nigel Heffernan Excellerando.Blogspot.com
' **** THIS CODE IS IN THE PUBLIC DOMAIN ****
On Error GoTo ErrSub
Dim strType As String
Dim strTyp1 As String
Dim strTyp2 As String
strExt = Trim(strExt)
' Set a default return: if an error is raised, return this value
GetExtensionType = Trim(strExt & " (unknown file type)")
strExt = Split(strExt, ".")(UBound(Split(strExt, "."))) '
If strExt = "" Then
Exit Function
End If
With CreateObject("WScript.Shell")
' This will go to error if there's no key for strExt in HKCR
strTyp1 = .RegRead("HKCR." & strExt & "\")
If strTyp1 = "" Then
strType = strExt & " File"
Else
' This value isn't very readable, eg: Access.ACCDEFile.14
' But we can use it to retrieve a descriptive string:
strTyp2 = .RegRead("HKCR\" & strTyp1 & "\")
If strTyp2 = "" Then
' So we didn't get a descriptive string:
' Parse some readability out of strType1:
strType = strTyp1
strType = Replace(strType, "File", " File")
strType = Replace(strType, ".", " ")
Else
strType = strTyp2
End If
End If
End With
If strType <> "" Then
GetExtensionType = strType
End If
ExitSub:
Exit Function
ErrSub:
Resume ExitSub
End Function
I made it error-tolerant but I didn't bother idiot-proofing it because someone, somewhere, is building a better idiot; and it's entirely possible that the user was actually right insofar as there really are files called that, and my system didn't have a registry entry for the file type in question.
There is an obvious source of errors in the code: GetExtensionType("docx") will give you 'Microsoft Word Document' on an English-Language workstation. If your user base are working with other languages and locales, they will see the descriptive name 'Microsoft Word Document' in their chosen language; and any validation logic you've coded up will fail to match that string (unless, of course, your string literals are internationalised in a conditional compiler block).
So any validation against a predefined application name or file type needs to be at the language-independent layer of the registry, using 'strTyp1' from the root instead of the locale-dependent strings passed into 'strTyp2'.
Use the FileSystemObject from the Scripting Runtime - it has a .GetBaseName() method to extract the basename from a file path:
'Early bound (reference to Microsoft Scripting Runtime):
Dim fso As New FileSystemObject
ActiveDocument.SaveAs2 fso.GetBaseName(ActiveDocument.Name), WdSaveFormat.wdFormatXMLDocument
'Late bound:
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
ActiveDocument.SaveAs2 fso.GetBaseName(ActiveDocument.Name), WdSaveFormat.wdFormatXMLDocument
You can also retrieve the extension with the .GetExtensionName() method, the path with .GetParentFolderName(), and the drive letter with GetDriveName() (which also works with UNC paths).
If you need to find the registered name of the extension in the current Windows install, you can either use the registry method #Nile answered with or an API call to AssocQueryStringA:
Const ASSOCSTR_FRIENDLYDOCNAME = 3
Private Declare Function AssocQueryString Lib "shlwapi.dll" _
Alias "AssocQueryStringA" ( _
ByRef Flags As Long, _
ByVal str As Long, _
ByVal pszAssoc As String, _
ByVal pszExtra As String, _
ByVal pszOut As String, _
ByRef pcchOut As Long) As Long
Sub Main()
Dim buffer As String
buffer = String$(255, " ")
Dim hresult As Long
hresult = AssocQueryString(0, ASSOCSTR_FRIENDLYDOCNAME, ".docm", _
vbNullString, buffer, 255)
If hresult = 0 Then
'Should be something like "Microsoft Word Macro-Enabled Document"
Debug.Print Trim$(buffer)
End If
End Sub
Note that you can also retrieve addition information about the associated file type by passing different values for the str parameter. See the ASSOCSTR enumeration.
I have been asked to create a console application which polls an active Directory. (C.\Temp\Input)
When a file comes in with (filename).SUCCESS, filename is retrieve in order to run a SQL query. So
IF fileextension = SUCCESS
Runs SQL Query using filename to change a value in the SQL Table.
Moves Original file to c:\temp\Input\Processed
Any help or hints would be much appreciated.
UPDATED:
Hi, With a few looks at various sites iv come up with the below. Forgetting the SQL for now, im only after the Filename and the moving of files but im getting an IO Exception that the file is already in use:
Imports System.IO
Imports System.String
Module Module1
Dim fileName As String = "C:\temp\Input\NR12345.success"
Dim pathname As String = "C:\temp\Input\"
Dim result As String
Dim sourceDir As String = "C:\temp\Input\"
Dim processedDir As String = "C:\temp\Input\Processed\"
Dim fList As String() = Directory.GetFiles(sourceDir, "*.success")
Sub Main()
result = Path.GetFileName(fileName)
Console.WriteLine("GetFileName('{0}') returns '{1}'", fileName, result)
result = Path.GetFileName(pathname)
Console.WriteLine("GetFileName('{0}') returns '{1}'", pathname, result)
Call MySub()
End Sub
Sub MySub()
'Move Files
For Each f As String In fList
'Remove path from the file name.
Dim fName As String = f.Substring(sourceDir.Length = 0)
Dim sourceFile = Path.Combine(sourceDir, fName)
Dim processedFileDir = Path.Combine(processedDir, fName)
' Use the Path.Combine method to safely append the file name to the path.
' Will overwrite if the destination file already exists.
File.Copy(Path.Combine(sourceDir, fName), Path.Combine(processedDir, fName), True)
'File.Copy(sourceFile, processedFileDir)
Next f
End Sub
End Module
I've used this before:
The FileWather Class
Really useful for polling directories for changes in structure and file details etc.
You can then use this to get an extension of a file and, if it meets your criteria, perform some actions.
These links come with examples so enjoy!!
Sub MySub()
'Move Files
For Each f As String In fList
Dim fInfo As FileInfo = New FileInfo(f)
Dim fName As String = fInfo.Name
Dim processedFileDir = Path.Combine(processedDir, fName)
' Use the Path.Combine method to safely append the file name to the path.
' Will overwrite if the destination file already exists.
File.Copy(fInfo.FullName, processedFileDir, True)
Next f
End Sub