Slow speed of VBA command (Application.FollowHyperlink) in a local network - vba

I am using a MS Access application in local network, this application have form for display data, and one of the features in the form is opening picture files regarding the data in the form. My issue is opening the pictures are very slow for the Front End users (1 to 5 seconds). This is my function for the opening photos:
Public Sub OpenPicture(PictureName As Variant)
If PictureName <> "" Then
DoCmd.SetWarnings False
Dim iPath , filePath As String
iPath = "C:\photo\"
filePath = iPath & PictureName
Application.FollowHyperlink filePath
DoCmd.Requery
DoCmd.SetWarnings True
End If
End Sub
In the above code, PictureName is the name of the image in the DataForm. I should mention there are Image controls for showing pictures in the DataForm, but these controls are small. My purpose is to crop or rotate these pictures in case of need in other programs.
Also I have a lot of image files (more than 200000) in the image source folder.
Please help me for improving the speed of this function.
Thanks in advance.

Related

MS Access VBA Dynamically Show Pics From URL

I found this code from here:
Show Pictures Directly From URLs in Access Forms and Reports
I have this code on my form:
Public Function PeopleImage()
'FUNCTION TO SET THE IMGPEOPLEPIC WITH THE CURRENT PERSON'S PHOTO, IF THE PHOTO CAN BE FOUND. OTHERWISE A STOCK IMAGE SAYING NO PIC FOUND WILL SHOW
Dim PeoplePic As String
Dim NoPeoplePic As String
Dim ImgDwnld As String
PeoplePic = "https://TheWebAddress.com/People%20Photos/" & Nz(Me.PersonID, 0) & ".jpg"
ImgDwnld = "\\AppServer\AppDir\Storage\Images\" & Nz(Me.PersonID, 0) & ".jpg"
DownloadFile PeoplePic, ImgDwnld, False
NoPeoplePic = "\\AppServer\AppDir\Storage\NoPeoplePic.jpg"
If FileExists(ImgDwnld) Then
Me.ImgPeoplePic.Picture = ImgDwnld
Else
Me.ImgPeoplePic.Picture = NoPeoplePic
End If
Me.ImgPeoplePic.Requery
End Function
When I added the image control ImgPeoplePic I set it to the NoPeoplePic, so that a picture would be set. Now, when I load the form and navigate, it looks like the photo is reloading (it blinks), but it just keeps showing the stock NoPeoplePic.
Anyone know what I'm missing? I feel like I'm so close. I just don't understand what it's not putting in the image that it downloads. I verified that the image downloads to the directory, and that it is there. I debug the path and image and it pulls up with no problem.
Any help is appreciated!

Copy file with progress bar bypass file replacement confirmation

This is a follow up to this question and great answer:
Copy files with progress bar
So I added the code from Siddharth Rout's answer and it does exactly what I want to happen with a minor exception. When I copy the files, I am looping through each file in the directory and copying it up as long as it is not *List.xml. Because I am replacing an existing library the 97% of the documents are pre-existing and I get prompted to replace existing documents each time.
Is there a way to get it to prompt me to choose to replace for all files? Do I need to reformat/structure the sequence of my code?
Function UploadToSharepoint(Folderpath As String, Foldername As String, Filenames() As String, SharepointLinks() As String) As Boolean
'upload file to sharepoint library based on the folder name
Dim SharePointLib As String
Dim LocalAddress As String
Dim DestinationAddress As String
Dim xCounter As Long
On Error GoTo loadFailed
Pickafolder:
Folderpath = FolderPick
Foldername = Left(Folderpath, Len(Folderpath) - 1)
Foldername = RIght(Foldername, Len(Foldername) - InStrRev(Foldername, "\"))
Select Case Foldername
Case "OPSS", "SSP", "OPSD", "MTOD", "SSD"
SharePointLib = "\\my.company.com\Subsite\" & Foldername & "\"
Case "West", "Eastern", "Northeastern", "Northwestern", "Head Office"
SharePointLib = "\\my.company.com\Subsite\NSP\" & Foldername & "\"
Case "NSP", "NSSP"
MsgBox "Pick the NSP regional sub folder: West, Eastern, Northeastern, Northwestern, Head Office"
GoTo Pickafolder
Case Else
MsgBox "Inappropriate directory to upload from. Please select one of the CPS download directories"
GoTo Pickafolder
End Select
Filenames = GetFilesDir(Folderpath)
ReDim SharepointLinks(LBound(Filenames) To UBound(Filenames))
For xCounter = LBound(Filenames) To UBound(Filenames)
LocalAddress = Folderpath & Filenames(xCounter)
DestinationAddress = SharePointLib & Filenames(xCounter)
'**********************************************************
Call VBCopyFolder(LocalAddress, DestinationAddress)
'**********************************************************
SharepointLinks(xCounter) = "#http:" & Replace(DestinationAddress, "\", "/") & "#"
Next xCounter
UploadToSharepoint = True
Exit Function
loadFailed:
UploadToSharepoint = False
End Function
And by the looks of things I am not excluding the file I was referring to earlier...must be doing that else where.
Update
Based on comment received at the linked question, the solution is to declare a public constant at the start:
Public Const FOF_NOCONFIRMATION As Long = &H10
and then in the copy procedure change the line of code to:
.fFlags = FOF_SIMPLEPROGRESS Or FOF_NOCONFIRMATION
Now, this does solve the problem of being constantly asked to confirm the replacement. I am very happy about this. The problem now is the progress window displays for the first file to be copied then disappears but fails to reappear for subsequent files. The remaining files still get copied and the prg carries on like it's supposed to. The whole point of the progress bar though was to let people know that "THINGS" were still happening in the background and now that is not happening. Is there something I need to adjust?
Update 2
After running my code and choosing a source directory on the network drive instead of the local computer, the copy window is popping up for every single file like I was expecting. I notice that sometimes the progress bar closes before reaching 100%. This leads me to believe that since the file sizes are so small that when it is copying from my local drive to sharepoint, the operation completes so fast that it does not have time to draw and update the progress window before its time to close it.

Manipulating FedEx label in vb.net API

I am writing a FedEx API in vb.net to work with our universe database. So far everything is about done but i'm stuck on the printing label part. The code FedEx gave me saves the label image as a pdf and prints from acrobat. Problem is you can't really do anything with a pdf image, or so i'm sure of at least, meaning i can't line the image up correctly on a 4 x 6 thermal label. How would i do this or is there a good way to just use the image and assign x and y coordinates without messing up the FedEx label? here is the code from where it saves the label down to print:
Sub ShowShipmentLabels(ByRef CompletedShipmentDetail As CompletedShipmentDetail, ByRef packageDetail As CompletedPackageDetail, ByVal isCodShipment As Boolean)
If (packageDetail.Label.Parts(0).Image IsNot Nothing) Then
' Save outbound shipping label
Dim FileName As String = getProperty("labelpath") + packageDetail.TrackingIds(0).TrackingNumber + ".pdf"
SaveLabel(FileName, packageDetail.Label.Parts(0).Image)
Mylabel.Print()
' Save COD Return label
If (isCodShipment) Then
FileName = getProperty("labelpath") + CompletedShipmentDetail.CompletedPackageDetails(0).TrackingIds(0).TrackingNumber + "CR.pdf"
SaveLabel(FileName, CompletedShipmentDetail.CompletedPackageDetails(0).CodReturnDetail.Label.Parts(0).Image)
End If
End If
End Sub
Sub SaveLabel(ByRef labelFileName As String, ByRef labelBuffer() As Byte)
' Save label buffer to file
Dim LabelFile As FileStream = New FileStream(labelFileName, FileMode.Create)
LabelFile.Write(labelBuffer, 0, labelBuffer.Length)
LabelFile.Close()
' Display label in Acrobat
DisplayLabel(labelFileName)
End Sub
Sub DisplayLabel(ByRef labelFileName As String)
Dim info As System.Diagnostics.ProcessStartInfo = New System.Diagnostics.ProcessStartInfo(labelFileName)
info.UseShellExecute = True
info.CreateNoWindow = True
info.WindowStyle = ProcessWindowStyle.Hidden
info.Verb = "Print"
System.Diagnostics.Process.Start(info)
End Sub
If it looks fine on the screen, but is not aligning correctly on the printer then you should probably look to the printer settings either on the device itself or in the driver. I would with the driver, you probably need to specificy the media and maybe adjust the margins.
Chris, if this hasn't been solved yet, check out this FAQ from our database at Shippo: http://support.goshippo.com/hc/en-us/articles/203804319-My-labels-are-not-printing-correctly-How-can-I-fix-this-
Printing 4x6 can be a bit of a headache at first. If it's not yet working for you, feel free to comment with more details what printer you use and your printer settings. This would help to debug further.
You have the option to save the image in ZPLII format. Do it and save it as tracking_id.zpl.
Share the Zebra printer as FedexThermal.
Then create a print.cmd script on he fly from vb to execute...
COPY /B tracking_id.zpl \\localhost\FedexThermal
Then in vb create a process to run that script,
Works for me.

In Listview assign each item (a folder) an image from with each folder

I am developing an application to find, play and display all media, but primarily music. I am using Visual Studio 2012 in vb.net. On my form I have a Windows Media Player (WMP) and two listviews. The first listview (lvFolders) displays all folders of drive location. When I select a folder it automatically loads all files (media tracks) into the second listview (lvPlaylist), and starts playing the first track using the WMP. That all works well.
In each of these folders (500+) I have a cover of the respective album named "front.bmp". I cannot for the life of me work out what I am doing wrong. As the listview is populating the folders I am trying for it to load each image file located within that folder into the imagelist, and display the folders as large icons using that image. The result would be 500+ large folders each displaying their respective album cover from the imagelist.
I specifically didn't want to use Folder Browser Dialog or Open File Dialog. This application is for a touch based application for my own personal use.
I have attached my code in case it helps understand my dilemma.
Private Sub LoadFolders_Click(sender As Object, e As EventArgs) Handles btnLoadFolders.Click
For Each strDir As String In My.Computer.FileSystem.GetDirectories("E:\Music\TEST")
Dim imageListLarge As New ImageList()
Dim strAlbumArt As String = strDir & "\" & (My.Computer.FileSystem.GetName(strDir)) & ".bmp" 'URL of the image
imageListLarge.ColorDepth = ColorDepth.Depth32Bit 'Set the colour
imageListLarge.ImageSize = New Size(128, 128) 'Set image size
imageListLarge.Images.Add(strAlbumArt, Image.FromFile(strAlbumArt)) 'Add image to image list
lvFolders.LargeImageList = imageListLarge 'Assign the imagelist to the listview
Dim NewItem As New ListViewItem(My.Computer.FileSystem.GetName(strDir), strAlbumArt) 'Create Column 1 data
NewItem.SubItems.Add(My.Computer.FileSystem.GetFileInfo(strDir).FullName) 'Create Column 2 data
lvFolders.Items.Add(NewItem) 'Load into listview
Next
End Sub
Dim strAlbumArt As String = strDir & "\" & (My.Computer.FileSystem.GetName(strDir)) & ".bmp"
doesn't have "front.bmp" in it. Are you sure you don't mean something like Dim strAlbumArt As String = strDir & "\front.bmp?

VB trouble loading data from a text file to list box

I am trying to get my application to show data from a text file to a list box with visual basics. I have it working for small sized text files no problem, but it will not work for text files the size of say 20mb. Is there any reason why it wouldn't load such or maybe some kind of limitations?
I forgot to ask, could it possibly just a matter of having to wait a long time? The program just sits there and I can't interact with it while it's getting the data...I think anyway....
Sub OpenFiles()
Dim myName As String = Dir(downloadTo + "*.TXT")
Do While myName <> ""
lstFiles.Items.Add(myName)
myName = Dir()
Loop
End Sub
Sub ReadFiles(textFile As String)
Dim logReader As New System.IO.StreamReader(textFile)
lstSrchTxt.Items.Clear()
While logReader.EndOfStream <> True
Dim stringx As String = logReader.ReadLine
If stringx.Contains(searchText) Then
lstSrchTxt.Items.Add(stringx)
End If
End While
logReader.Close()
End Sub
The issue was that I was entering too much data and it needed time to process all of the characters.