I came across an article on implementing .zip VB file compression in VS2013 but have a snag in implementing it.
When I get to the line System.IO.Compression.ZipFile.CreateFromDirectory, I get an error in VS that .ZipFile is not a member of ".Compression".
Here’s the code for my command button (using user3688529's code) called zipButton and listbox called filesListBox:
Private Sub zipButton_Click(sender As Object, e As EventArgs) Handles zipButton.Click
'Button click events.
'Start backup.
Dim PjtPath As String = TextBox1.Text
Dim ZipLocal As String = TextBox2.Text
Dim ZipNetwk As String = TextBox3.Text
Static Dim StartPath As String
Static Dim ZipPath As String
For Each a As String In filesListBox.SelectedItems()
'Dim PjtName As String = ListBox1.SelectedItems(a).ToString
Dim PjtName As String = a
Dim ZipExt As String = Format(Now, " yyyy-MM-dd # HHmm") & ".zip"
If TextBox2.Text = String.Empty Then
StartPath = PjtPath & "\" & PjtName
ZipPath = PjtPath & "\" & PjtName & ZipExt
ElseIf TextBox2.Text <> String.Empty Then
StartPath = PjtPath & "\" & PjtName
ZipPath = ZipLocal & "\" & PjtName & ZipExt
End If
System.IO.Compression.ZipFile.CreateFromDirectory _
(StartPath, ZipPath, IO.Compression.CompressionLevel.Optimal, True)
If TextBox3.Text <> String.Empty Then
Dim ZipCopy As String = ZipNetwk & "\" & PjtName & ZipExt
My.Computer.FileSystem.CopyFile(ZipPath, ZipCopy)
End If
Next
End Sub
Is there some module I need to include in order for the .ZipFle member to be accessable?
You probably need to add a reference to System.IO.Compression.FileSystem in your project references.
"Project -> Add Reference". Under Framework, find System.IO.Compression.FileSystem.
Related
I have a small problem.
I have two for each routines. One gives me all foldernames in the current folder. The other gives me all window names opened. Both are saving the results in a String. One with newlines, the other with ~, so I can loop through both and get all the items one by one.
This is the part:
Dim Folders As String
For Each Dir As String In System.IO.Directory.GetDirectories(My.Computer.FileSystem.CurrentDirectory & "\Data\")
Dim dirInfo As New System.IO.DirectoryInfo(Dir)
Folders = Folders & dirInfo.Name & "~"
Next
Dim FolderList() As String = Folders.Split("~")
Dim p As Process
Dim Windows As String
For Each p In Process.GetProcesses
Windows = Windows & vbNewLine & p.MainWindowTitle.ToString
Next
Windows = LineTrim(Windows)
This works. But now, I want to compare them.
I only want to get the Folders, where a window exists, which contains the foldername.
For example, I have 3 folders: Test1,Test2,Test3.
I have one Window opened: "Test1 - Window"
Now I only want to get "Test1" as Result once.
I got it working so far, but I get "Test1" 3 times, because there are 3 folders. Because I am creating new Windows by this info, my function spams new windows..
This is the whole function:
Dim Folders As String
For Each Dir As String In System.IO.Directory.GetDirectories(My.Computer.FileSystem.CurrentDirectory & "\Data\")
Dim dirInfo As New System.IO.DirectoryInfo(Dir)
Folders = Folders & dirInfo.Name & "~"
Next
Dim str As String() = Folders.Split("~")
For Each Folder As String In str
If (My.Computer.FileSystem.FileExists(My.Computer.FileSystem.CurrentDirectory & "\Data\" & Folder & "\" & "Status.txt")) Then
Dim StartTime As String = Inireader.WertLesen("Settings", "StartTime", My.Computer.FileSystem.CurrentDirectory & "\Data\" & Folder & "\Time.ini")
Dim StopTime As String = Inireader.WertLesen("Settings", "StopTime", My.Computer.FileSystem.CurrentDirectory & "\Data\" & Folder & "\Time.ini")
If (IsInTime(StartTime, StopTime) = True) Then
Dim p As Process
Dim Windows As String
For Each p In Process.GetProcesses
Windows = Windows & vbNewLine & p.MainWindowTitle.ToString
Next
Windows = LineTrim(Windows)
Dim Ar() As String = Split(Windows, Environment.NewLine)
For Each Window As String In Ar
If sX.ToString.Contains(Window & " - python " & My.Computer.FileSystem.CurrentDirectory & "\Data\" & Window& "\" & Window & ".py") Then ''''The Spam cause line
Else
Dim Path = My.Computer.FileSystem.CurrentDirectory & "\Data\" & Folder & "\" & Folder & ".py"
Dim startInfo As New ProcessStartInfo
startInfo.FileName = "cmd.exe"
startInfo.Arguments = "/k " & "title " & Folder & " & python " & Path
startInfo.WorkingDirectory = My.Computer.FileSystem.CurrentDirectory & "\Data\" & Folder & "\"
Process.Start(startInfo)
End If
Next
End If
End If
Next
I can´t shorten it very much..
Could you help me out?
Thank you :)
Best regards!
I'm searching for a filename and outputting it to a textbox on my form. The search is working, but I do not want to output the filename i'm searching, only the filenames of the additional filenames I've found. Any ideas? Here's my code:
Dim pathway As String = "C:\myFolder\"
Dim dirs As String() = Directory.GetFiles(pathway, "myFile" & "*.xlsm")
If dirs.Length >= 1 Then
myTextBox.Text = "Additional Reports: " & vbCrLf & String.Join(", ", dirs.Select(Function(x) Path.GetFileNameWithoutExtension(x)))
End if
You can add an "except" filter to your enumeration:
Dim pathway As String = "C:\myFolder"
Dim fileName As String = "myFile"
Dim dirs As String() = Directory.GetFiles(pathway, fileName & "*.xlsm")
If dirs.Length >= 1 Then
TextBox2.Text = "Additional Reports: " & Environment.NewLine &
String.Join(", ", dirs.Select(Function(x) Path.GetFileNameWithoutExtension(x)) _
.Except(New String() {fileName}))
End If
I have a small piece of code under a command button click which saves the workbook file with a new name in a new location, I am wondering if it is possible to also automatically create a shortcut to that newly saved workbook in a different location?
Private Sub CommandButton1_Click()
Dim SelectedFNumber As String
Dim DateStr As String
Dim myFileName As String
Dim StorePath As String
DateStr = Format(Now, "dd.mm.yy HH.mm")
SelectedFNumber = Range("B4").Text
If SelectedFNumber <> "SELECT F NUMBER" And Range("D11") > "0" Then
StorePath = "G:\Targets\" & SelectedFNumber & "\"
myFileName = StorePath & SelectedFNumber & " " & DateStr & ".xlsm
If Len(Dir(StorePath, vbDirectory)) = 0 Then
MkDir StorePath
End If
ActiveWorkbook.SaveAs Filename:=myFileName, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Else
MsgBox "Select an F Number"
End If
End Sub
You basically need to add something like this:
Dim sShortcutLocation As String
sShortcutLocation = "C:\blah\workbook shortcut.lnk"
With CreateObject("WScript.Shell").CreateShortcut(sShortcutLocation)
.TargetPath = myFileName
.Description = "Shortcut to the file"
.Save
End With
changing the location to wherever you want.
I want to change something on a compiled game file, so I used this code:
Private Sub Next2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Next2.Click
Dim reader As New System.IO.StreamReader("Languages/" & Language & ".Devil")
Dim allLines As List(Of String) = New List(Of String)
Do While Not reader.EndOfStream
allLines.Add(reader.ReadLine())
Loop
reader.Close()
Tips.Text = ReadLine(6, allLines)
WeaponsListBox.Hide()
NewWeaponsList.Hide()
Next2.Hide()
Dim curItem As String = WeaponsListBox.SelectedItem.ToString()
Dim curItem2 As String = NewWeaponsList.SelectedItem.ToString()
Try
If MainWeapon = "Cheytac" Then
Dim supahotfire As String = curItem.Substring(0, 12)
Dim hotdestroyer As String = curItem.Replace(supahotfire, "")
Dim supa2 As String = curItem2.Substring(0, 12)
Dim hot2 As String = curItem2.Replace(supa2, "")
Dim oldfile As String = "pack/Weapon_" & curItem & ".i3pack"
Dim FileName As String = "pack/pack_" & MainWeapon & hot2 & "_" & hotdestroyer & ".i3pack"
Dim be = My.Computer.FileSystem.ReadAllBytes(oldfile)
Dim be2 As String = UnicodeBytesToString(be)
be2.Replace("Weapon\" & curItem & "/" & curItem & "_diff", "Weapon\" & curItem2 & "/" & curItem2 & "_diff")
Dim be3 As String = be2.Replace("Weapon\" & curItem & "/Cheytac_M200_Diff.i3i", "Weapon\" & curItem2 & "/Cheytac_M200_Diff.i3i")
Dim be4 = UnicodeStringToBytes(be3)
My.Computer.FileSystem.WriteAllBytes(FileName, be4, True)
'System.IO.File.AppendAllText(FileName, be4)
' Dim fs As FileStream = New FileStream(oldfile, FileMode.Open)
' Dim br As BinaryReader = New BinaryReader(fs)
'Dim bin as byte[]= br.ReadBytes(Convert.ToInt32(fs.Length));
' fs.Close()
'br.Close()
End If
Catch ex As Exception
System.IO.File.AppendAllText("MathimaticalErrors.txt", ex.ToString)
End Try
End Sub
Public Function UnicodeBytesToString(ByVal bytes() As Byte) As String
Return System.Text.Encoding.Unicode.GetString(bytes)
End Function
Public Function UnicodeStringToBytes(ByVal str As String) As Byte()
Return System.Text.Encoding.Unicode.GetBytes(str)
End Function
The problem is that the newly created file is basically the same as the old file, and nothing has changed on it. How can I solve this?
At this point in your code:
Dim be2 As String = UnicodeBytesToString(be)
be2.Replace("Weapon\" & curItem & "/" & curItem & "_diff", "Weapon\" & curItem2 & "/" & curItem2 & "_diff")
The value in be2 would remain unchanged. You have to store the return value of Replace():
Dim be2 As String = UnicodeBytesToString(be)
be2 = be2.Replace("Weapon\" & curItem & "/" & curItem & "_diff", "Weapon\" & curItem2 & "/" & curItem2 & "_diff")
Also, at this line:
My.Computer.FileSystem.WriteAllBytes(FileName, be4, True)
The True at the end means you want to append the bytes. If the file is empty this will be fine. If not, then you'll end up adding the bytes to the end of the file each time. Not sure if that is your intended result...
I've a function that check update for my application. I've two mode for execute this function, in the first time that the application's start and in the tooltip menu. If I execute the software for the first time all working good, the update is found , but if I press on my button in the tooltip menu the same function (the exact function) not working. In particular the update is found but the software for download it (infinity blue) doesn't start.
This is the function:
Dim MyAppName As String = "Sund.exe"
Dim url As String = "www.site.com/update/" & "FileUpdates371.php"
Dim pageRequest As HttpWebRequest = CType(WebRequest.Create(url), HttpWebRequest)
Dim pageResponse As WebResponse = pageRequest.GetResponse()
Dim filelist As String : Dim Mainlist As String
Using r As New StreamReader(pageResponse.GetResponseStream())
filelist = r.ReadToEnd
If Not IO.File.Exists(Application.StartupPath & "\" & "Updates") Then
IO.File.WriteAllText(Application.StartupPath & "\" & "Updates", filelist)
End If
Dim sr As New StreamReader(Application.StartupPath & "\" & "Updates")
Mainlist = sr.ReadToEnd
Dim FileLines() As String = filelist.Split(New String() {Environment.NewLine}, StringSplitOptions.RemoveEmptyEntries)
Dim MainLines() As String = Mainlist.Split(New String() {Environment.NewLine}, StringSplitOptions.RemoveEmptyEntries)
If Not Mainlist = filelist And Not FileLines.Length < MainLines.Length Then
Dim answer As DialogResult
answer = MessageBox.Show("Update available", "Update", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
If answer = vbYes Then
Dim App As New Process
App.StartInfo.FileName = Application.StartupPath & "\" & "InfinityBlue.exe"
App.StartInfo.Arguments = "Update|" & MyAppName & "|" & url
App.Start()
Me.Close()
End If
End If
End Using
If My.Computer.FileSystem.FileExists(Application.StartupPath & "\" & "InfinityBlueUpdate.exe") Then
My.Computer.FileSystem.DeleteFile(Application.StartupPath & "\" & "InfinityBlue.exe", FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.DeletePermanently)
My.Computer.FileSystem.RenameFile(Application.StartupPath & "\" & "InfinityBlueUpdate.exe", "InfinityBlue.exe")
End If
I've also tried to catch the exception and there isn't exception. Why happean this?