When I load images using openfiledialog I need to store a backup copy of the images to the other folder using the same filename and with the same extension.So how do i do that as in the below mentioned code I am able to copy only one image and I have given random string for that image.But I don't need that.I want to copy with the same filename and with the same extension.And if I have the same filename it should overwrite it but not with a different name and extension.
Any help will be greatly appreciated.
If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
OpenFileDialog1.Multiselect = True
Dim r As New Random()
Dim i As Integer
Dim strTemp As String = ""
For i = 0 To 8
strTemp = strTemp & Chr(CInt(Int((26 * r.NextDouble()) + 65)))
Next
Dim str As String
For Each str In OpenFileDialog1.FileNames
System.IO.File.Copy(str, Application.StartupPath + "\DownloadedImages\" & "strTemp.jpg", True)
Next
End If
And I achieved it but there is one problem I am able to copy one image can you say me how to do it for multiple images.And here is the code:
Dim fso As New FileSystemObject
Dim str As String
str = OpenFileDialog1.FileName
MyExtension = fso.GetExtensionName(str)
For i = 0 To OpenFileDialog1.FileNames.Length - 1
System.IO.File.Copy(OpenFileDialog1.FileNames(i), Application.StartupPath + "\DownloadedImages\" + strTemp & "." & MyExtension, True)
Next
This line:
System.IO.File.Copy(str, Application.StartupPath + "\DownloadedImages\" & "strTemp.jpg", True)
Should read:
System.IO.File.Copy(str, Application.StartupPath + "\DownloadedImages\" & strTemp & ".jpg", True)
You should use the Path class. It has methods for getting files names with or without extension as well getting the extension only.
Also, strTemp should not be in quotes as this will be the literal string "strTemp" not the value in the variable strTemp
If OpenFileDialog1.ShowDialog = Windows.Forms.DialogResult.OK Then
Dim str As String
For Each str In OpenFileDialog1.FileNames
Dim fso As New FileSystemObject
Dim MyName As String
Dim MyExtension As String
MyName = fso.GetFileName(CStr(str))
MyExtension = fso.GetExtensionName(MyName)
System.IO.File.Copy(str, Application.StartupPath + "\Backup\" + MyName & "." & MyExtension, True)
CheckedListBox1.Items.Add(str, CheckState.Checked)
Thumbcontrol1.AddThumbnail(str)
Thumbcontrol1.BackgroundImage = Nothing
CheckedListBox1.SelectedIndex = 0
Next
Related
I have an image control named itemImage set to ItemImage field on the table.
I am using a file picker to browse to a location and copy an image then save it to a different location, and rename it using a textbox value, then add its full location to the table.
Question:
Does the image control on access work with .jpg files? or do I need to convert to .bmp? if so how do I maintain the file extension when I copy a file from one location to another?
Is there a better or more efficient way of accomplishing this kind of task?
My current attempt copies the image but does not display a known .bmp image on the form.
Please see below:
Private Sub itemImage_DblClick(Cancel As Integer)
On Error GoTo 0
Dim ofd As Object
Dim fso As Object
Dim theFile As String
Dim theFileLocation As String
Dim filePath As String
Dim fullFileName As String
Dim theFileName As String
Set ofd = Application.FileDialog(3)
ofd.AllowMultiSelect = False
ofd.Show
If ofd.SelectedItems.Count = 1 Then
theFile = Mid(ofd.SelectedItems(1), InStrRev(ofd.SelectedItems(1), "\") + 1, Len(ofd.SelectedItems(1)))
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
filePath = ofd.SelectedItems(1)
CopyImage filePath, Me.donationNumber & Mid(ofd.SelectedItems(1), InStrRev(ofd.SelectedItems(1), "."))
CurrentDb.Execute "UPDATE tblDonatedItems SET ItemImage = '" & Application.CurrentProject.Path + "\ItemImages\" + donationNumber.Value + Mid(ofd.SelectedItems(1), InStrRev(ofd.SelectedItems(1), ".")) & "' WHERE DonationNumber = '" & Me.donationNumber.Value & "'", dbFailOnError
Else
MsgBox "Image update Cancel!"
End If
End Sub
Sub CopyImage(filePath As String, fileName As String)
Dim fs As Object
Dim images_path As String
images_path = CurrentProject.Path & "\ItemImages\"
Set fs = CreateObject("Scripting.FileSystemObject")
fs.CopyFile filePath, images_path & fileName
Set fs = Nothing
End Sub
As I understand, the actual issue is with jpeg file extension, not jpg. Access is not rendering jpeg image in Image control. I also observe that simply changing file extension from jpeg to jpg allows Access to render the file. So consider:
strExt = Mid(ofd.SelectedItems(1), InStrRev(ofd.SelectedItems(1), "."))
If strExt = ".jpeg" Then strExt = ".jpg"
Or don't bother with strExt and If Then conditional and just use Replace() function. Also, using FileCopy would be like:
FileCopy filePath, images_path & Replace(fileName, ".jpeg", ".jpg")
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?
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.
I need code to read a .txt file which is in my project bin\debug directory that contains SQL code to create tables in a large number it size of 936kb
This following code only I'm using...
By using this it gives result like table created but it is not reading the file... there is nothing in the database
Public Function readTextFile(ByVal fileName As String) As String
Dim strContent As String()
Dim x As String = ""
Try
'fileName = "CSYSS802.txt"
If Not System.IO.File.Exists(fileName) Then
'o Until EOF()
strContent = System.IO.File.ReadAllLines(fileName)
For Each Str As String In strContent
x = x + Str
Next
readTextFile = x
End If
Catch ex As Exception
MessageBox.Show(ex.ToString)
End Try
readTextFile = x
End Function
Public Sub createTable(ByVal vdbs As String, ByVal file As String)
username = frmlogin.txtusername.Text
password = frmlogin.txtusername.Text
vsvr = vServer
vdb = Trim$(vdbs)
strCon1 = "Server=" & vsvr & ";Database=" & vdb & ";uid=" & username & ";pwd=" & password & ";"
sqlCon1 = New SqlClient.SqlConnection(strCon1)
sqlCon1.Open()
Dim arr() As String
arr = Split(readTextFile(file), "GO")
Dim i As String
For Each i In arr
If i <> "" Then
Dim cmd2 As New SqlClient.SqlCommand("" & i & "")
cmd2.CommandType = CommandType.Text
cmd2.ExecuteNonQuery()
End If
Next
End Sub
In the readTextFile function, it will only attempt to read the text from the text file if the file DOESN'T exist. If the text file exists then the function returns an empty string and if the text file doesn't exist, the function will throw a file not found exception.
Replace:
If Not System.IO.File.Exists(fileName) Then
with:
If System.IO.File.Exists(fileName) = True Then
You might also want to include an Else clause in case the file doesn't exist as it won't throw an error since you have handled it correctly.
If System.IO.File.Exists(fileName) = True Then
strContent = System.IO.File.ReadAllLines(fileName)
For Each Str As String In strContent
x &= Str
Next
Return x
Else
MessageBox.Show("The file '" & fileName & "' does not exist.")
Return ""
End If
My Self I had Found The solution..I attache the Following Code...It now Creating All tables Properly..
Make sure that each Sql Commands in your Text File ends with go.. because i used "GO" Keyword to split the text...
Public Sub createTable(ByVal vdbs As String, ByVal file As String)
username = frmlogin.txtusername.Text
password = frmlogin.txtusername.Text
vsvr = vServer
vdb = Trim$(vdbs)
strCon1 = "Server=" & vsvr & ";Database=" & vdb & ";uid=" & username & ";pwd=" & password & ";"
sqlCon1 = New SqlClient.SqlConnection(strCon1)
sqlCon1.Open()
Dim arr() As String
arr = Split(readTextFile(file), " GO ")
Dim i As String
For Each i In arr
If i <> "" Then
Dim cmd2 As New SqlClient.SqlCommand("" & i & "", sqlCon1)
cmd2.CommandType = CommandType.Text
cmd2.ExecuteNonQuery()
End If
Next
End Sub
Public Function readTextFile(ByVal file As String) As String
Dim fso As New System.Object
Dim ts As Scripting.TextStream
Dim sLine As String
fso = CreateObject("Scripting.FileSystemObject")
ts = fso.openTextFile(file)
Do Until ts.AtEndOfStream
sLine = sLine & " " & ts.ReadLine
Loop
ts.Close()
fso = Nothing
readTextFile = sLine
End Function
We have a service that provides several files per day for pickup. Each file is appended with today's date and the hours, minutes, seconds and milliseconds stamp of the time the file was created.
Our goal is to download all files for a given day regardless of the time stamp. I've set the following variable:
Dim remoteFile As String = "/datafeed/sdlookup-total-" & DateTime.Today.Year.ToString
& "-" & DateTime.Today.Month.ToString("0#") & "-" & DateTime.Today.Day.ToString("0#") &
".csv.zip"
When I run the console application, I receive a HTTP 550 file not found because the files on the FTP all have the timestamp after the day e.g.
sdlookup-total-2013-07-27_02_15_00_272.csv.zip
The Module is as follows:
Imports System.IO
Imports System.IO.Compression
Imports System.Net
Imports System.Net.WebClient
' This module when run will download the file specified and save it to the local path as defined.
Module Module1
Dim Today As Date = Now()
' Change the value of localFile to the desired local path and filename
Dim localFile As String = "C:\ForeclosureFile\sdlookoup-total-" & Today.Year.ToString & "-" &
Today.Month.ToString("0#") & "-" & Today.Day.ToString("0#") & ".csv.zip"
' Change the value of remoteFile to the desired filename
Dim remoteFile As String = "/datafeed/sdlookup-total-" & Today.Year.ToString & "-" &
Today.Month.ToString("0#") & "-" & Today.Day.ToString("0#") & ".csv.zip"
Const host As String = "ftp://Datafeed.foreclosure.com"
Const username As String = "sdlookup"
Const pw As String = "ourpass"
Dim strDownLoadTemplate = "sdlookup-total-" & Today.Year.ToString & "-" & Today.Month.ToString
("0#") & "-" & Today.Day.ToString("0#") & ".csv.zip"
Dim strCleanFileForDTS As String
Dim strLocalZipFile = "C:\ForeclosureFile\ForeclosureFull.zip"
Dim strLocalCSVFile = "C:\ForeclosureFile\Foreclosurefull.csv"
Sub Main()
Dim URI As String = host + remoteFile
Dim req As FtpWebRequest = CType(FtpWebRequest.Create(URI), FtpWebRequest)
req.Credentials = New NetworkCredential(username, pw)
req.KeepAlive = False
req.UseBinary = True
req.Method = System.Net.WebRequestMethods.Ftp.DownloadFile
Using response As System.Net.FtpWebResponse = CType(req.GetResponse,
System.Net.FtpWebResponse)
Using responseStream As IO.Stream = response.GetResponseStream
Using fs As New IO.FileStream(localFile, IO.FileMode.Create)
Dim buffer(2047) As Byte
Dim read As Integer = 0
Do
read = responseStream.Read(buffer, 0, buffer.Length)
fs.Write(buffer, 0, read)
Loop Until read = 0
responseStream.Close()
fs.Flush()
fs.Close()
End Using
responseStream.Close()
End Using
response.Close()
End Using
Dim zipPath As String = "C:\ForeclosureFile\"
Dim extractPath As String = "C:\ForeclousreFile"
ZipFile.ExtractToDirectory(zipPath, extractPath)
End Sub
Sub ProcessFile()
'Downloaded file
Dim oFile As System.IO.File
Dim oRead As System.IO.StreamReader
Dim strLocalCSVFile As String = "C:\ForeclosureFile\sdlookoup-total-" &
DateTime.Today.Year.ToString & "-" & DateTime.Today.Month.ToString("0#") & "-" &
DateTime.Today.Day.ToString("0#") & ".csv"
Dim strCleanFileForDTS As String = "C:\ForeclosureFile\ForDTS\sdlookoup-total-" &
DateTime.Today.Year.ToString & "-" & DateTime.Today.Month.ToString("0#") & "-" &
DateTime.Today.Day.ToString("0#") & ".csv"
Dim LineIn As String
'Dim Fields() As String
'New File
Dim oNewFile As System.IO.File
Dim oWrite As System.IO.StreamWriter
oWrite = File.CreateText(localFile & strCleanFileForDTS)
oRead = File.OpenText(localFile & strLocalCSVFile)
' strLocalCSVFile()
While oRead.Peek <> -1
'While oRead.
LineIn = oRead.ReadLine()
'Fixes file problem
oWrite.WriteLine(Replace(LineIn, """", "", 1))
End While
oRead.Close()
oWrite.Close()
End Sub
Sub FTPFileDownload(strtFetchFile As String, PathToSave As String)
Dim myFtpWebRequest As FtpWebRequest
Dim myFtpWebResponse As FtpWebResponse
Dim myStreamWriter As StreamWriter
Dim strFullPathandFile As String
strFullPathandFile = PathToSave & strtFetchFile
myFtpWebRequest = WebRequest.Create("ftp://Datafeed.foreclosure.com/datafeed/" &
strtFetchFile)
myFtpWebRequest.Credentials = New NetworkCredential("sdlookup", "ohpaiH1b")
myFtpWebRequest.Method = WebRequestMethods.Ftp.DownloadFile
myFtpWebRequest.UseBinary = True
myFtpWebRequest.UsePassive = True
myFtpWebResponse = myFtpWebRequest.GetResponse()
PathToSave = "D:\test.zip"
myStreamWriter = New StreamWriter(PathToSave)
myStreamWriter.Write(New StreamReader(myFtpWebResponse.GetResponseStream()).ReadToEnd)
myStreamWriter.Close()
' litResponse.Text = myFtpWebResponse.StatusDescription
myFtpWebResponse.Close()
End Sub
Public Sub DownloadFiles(ByVal Wildcard As String)
Wildcard = "sdlookup-total-*.csv.zip"
Dim Files As String() = GetFiles(Wildcard)
For Each file As String In Files
DownloadFile(file)
Next
End Sub
End Module
How should I modify the above module so that all files containing sdlookup-total-"Today'sDate".csv.zip regardless of timestamp are downloaded each time the module is executed?