I'm in the process of creating a database with many chemicals & associated .pdf files with their information.
Each chemical has a unique ID and in the same row has a link to the .pdf file on the network.
In addition, each chemical has a location assigned to it.
My goal is to be able to print all .pdf associated with chemicals in each location.
For example:
ID Chemical Location PDF-link
1 Acetone Lab-A A:/folder/1.pdf
2 Fire Lab-A A:/folder/2.pdf
1 Acetone Lab-B A:/folder/1.pdf
3 Sponge Lab-B A:/folder/3.pdf
4 Candy Lab-B A:/folder/4.pdf
If I specify Lab-A, I would like it to print both PDFs: 1.pdf, 2.pdf.
If I specify Lab-B, I would like it to print those respective .pdf files.
Of course I also want to be able to print all of them as well, but I think if I figure out how to do the above, I can manage to do this.
Thanks for any help.
The code to do this will look like this:
Sub PrintMyPdf()
Dim rst As DAO.Recordset
Dim strSQL As String
strSQL = "select * from tblChem where Location = '" & Me.txtLocation & "'"
Set rst = CurrentDb.OpenRecordset(strSQL)
Do While rst.EOF = -False
Call PrintOnePdf(rst![PDF-link])
rst.MoveNext
Loop
rst.Close
End Sub
Sub PrintOnePdf(strF As String)
CreateObject("Shell.Application").Namespace(0).ParseName(strF).InvokeVerb ("Print")
End Sub
The above code assumes you have a text box on the form of txtLocation, and then the above code can be placed behind a button click even (or simply call the above code from the button click even.
The above code assumes you have some type of PDF reader for the printing to occur.
Have a look at this: http://www.jpsoftwaretech.com/open-or-print-files-in-vba/
I have used it successfully by putting a command button on a form e.g:
In a module I put this:
Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
ByVal lpParameters As String, ByVal lpDirectory As String, _
ByVal nShowCmd As Long) As Long
The OnClick event for one of my command buttons is:
PathName1 = "Full path.pdf"
PathName2 = "Full path.rtf"
ExecuteFile PathName1, printfile
ExecuteFile PathName2, printfile
You'll need to set up a Select Case or If Then Else statement to print what you actually want.
Related
I tried to follow up with the topic here:
How to connect to OPEN workbook in another instance of Excel
But I ran into a problem,
I am not able grab the new instance name or path.
However I know I have open Excel window in another instance (opened from a SAP system) and when I open VBA editor in that SAP generated Excel file and I type: ? Thisworkbook.Path in immediate window I get nothing, no path is given and thus this solutions does not get the instance path.
What can I do to make it work ?
My issue is that this: Set xlApp = GetObject("C:\Tmp\TestData2.xlsx") is not grabbing the workbook name (including This.workbook.name or activeworkbook.name)
Any idea how else I can make VBA code in instance 1 work with workbook in instance 2?
I only want to save it nothing more, I'm using Saveas option, or at least I try.
Have anyone had a similar issue?
Working with the Excel files downloaded from SAP is always problematic.
You can use the module below and add before the xls.Close SaveChanges:=False this line xls.SaveAs Filename:='Any name that you want after that just place a call in your code after downloading the Excel File with
Call Close_SAP_Excel("TestData2.xlsx")
And it should work fine.
Module:
#If VBA7 Then
Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
ByVal hwnd As LongPtr, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
Private Declare PtrSafe Function FindWindowExA Lib "user32" ( _
ByVal hwndParent As LongPtr, ByVal hwndChildAfter As LongPtr, _
ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr
#Else
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" ( _
ByVal hwnd As Long, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long
Private Declare Function FindWindowExA Lib "user32" ( _
ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
ByVal lpszClass As String, ByVal lpszWindow As String) As Long
#End If
Sub Close_SAP_Excel(ParamArray FileNames())
'Procedure to close files downloaded from SAP and at the same time close the Excel application instance that will be open with them.
Dim ExcelAppSAP As Variant
Dim ExcelFile As Variant
Dim FinishedLoop As Boolean, TimeoutReached As Boolean, FileClosed As Boolean
Dim ReTry As Long
Dim i As Long, x As Long
Set ExcelAppSAP = Nothing
ReTry = 100000 'Used as Timeout 100000 = ~10 seconds
i = 1
'The following loop is executed until excel file is closed.
'Inside of this, there is a For Loop for each Excel Instance and inside of that is another loop
'for each excel inside the instance. If name matches, it is closed.
Do While Not FinishedLoop
If i > ReTry Then
TimeoutReached = True
Exit Do
End If
For Each ExcelFile In GetExcelInstances() 'Function to Get Excel Open Instances
For Each xls In ExcelFile.Workbooks
For x = LBound(FileNames()) To UBound(FileNames())
If xls.Name = FileNames(x) Then
Set ExcelAppSAP = ExcelFile 'Set Instance opened by SAP to variable
'Here add actions if needed. Reference to workbook as xls e.g.: xls.Sheets(1).Range("A1").Copy
xls.Close SaveChanges:=False
FileClosed = True
End If
Next x
Next
Next
If FileClosed Then
FinishedLoop = True
End If
i = i + 1
Loop
ThisWorkbook.Activate
If Not TimeoutReached Then
If FileClosed Then
On Error Resume Next
If ExcelAppSAP.Workbooks.Count = 0 Then
ExcelAppSAP.Quit
End If
Else
MsgBox "Excel application instance from SAP was not closed correctly. Please close it manually or try again.", , "Error"
End If
Else
MsgBox "Max timeout reached", , "Error"
End If
End Sub
Public Function GetExcelInstances() As Collection
Dim guid&(0 To 3), acc As Object, hwnd, hwnd2, hwnd3
guid(0) = &H20400
guid(1) = &H0
guid(2) = &HC0
guid(3) = &H46000000
Set GetExcelInstances = New Collection
Do
hwnd = FindWindowExA(0, hwnd, "XLMAIN", vbNullString)
If hwnd = 0 Then Exit Do
hwnd2 = FindWindowExA(hwnd, 0, "XLDESK", vbNullString)
hwnd3 = FindWindowExA(hwnd2, 0, "EXCEL7", vbNullString)
If AccessibleObjectFromWindow(hwnd3, &HFFFFFFF0, guid(0), acc) = 0 Then
GetExcelInstances.Add acc.Application
End If
Loop
End Function
I have some issues downloading an image (or zip sometimes) from a webpage.
I've checked a few forums about the topic where most of the time they suggest using the URLDownloadToFile function.
I tried to apply it but it doesn't seem to work.
Here's an example of the type of webpage I'm dealing with :
The type here is jpg but sometimes it can be a zip.
For the jpg case, I have two ways to do it:
Click on the View button, which will open a new webpage containing 1 image only, selecting that webpage and somehow dowloading the image, which I don't manage to do.
(There is a "Save Picture As" when you rigth click a picture manually, but how to access to this with VBA ? ) :
objIE.document.frames(1).frames(1).document.getElementById("notPrintable").document.getElementsByName("view")(0).Click 'This clicks on the View Button
attachment_url = "https://pumapgf-row.bmwgroup.net/puma/case/showfile.do?selectedIndex=" & elem_id & "&filename=" & elem_name & "%20%7C%20jpg%20%7C%20" & end_url ' this is the url of the new webpage which is opened when I click the view button
Set objIE = IEWindowFromLocation(attachment_url) ' I select the new webpage
Set IEDoc = objIE.document ' set document on it
The html from this new webpage in the case it's a jpg of course) looks like this:
What I tried to do then but unsuccessfully is to use the URLDownloadToFile function this way
Dim myImages As IHTMLElementCollection
Set myImages = IEDoc.getElementsByTagName("img")
returnValue = URLDownloadToFile(0, myImages(0).href, "P:\Alex\ABC.img", 0, 0)
Whether I create or not a such called file before I run the code, it doesn't make any difference. I also tried with .jpg, .img, .png.
myImages(0).href ends like this :
So I don't know if the fact that .href doesn't end with something like .jpg or .img is an issue.
Click on the Save As button : valid for both jpg and zip files, so would be a better solution. I manage to click on it of course, but the issue comes from the fact that Internet displays this and I have no idea how to deal with it.
Any idea how to do this ?
EDIT : Here is the properties window of the image
Assuming that you have a valid download URL (which I can't test based on the site in your question), all you should need to do to test if a file is a jpg is to download it and check for the presence of the JPEG file header:
Public Function FileIsJpg(filepath As String) As Boolean
Dim handle As Long
handle = FreeFile
Open filepath For Binary As #handle
Dim header As Integer
Get #handle, , header
'Note the byte order.
If header = &HD8FF Then
Get #handle, , header
If header = &HE0FF Or header = &H1FF Then
FileIsJpg = True
End If
End If
Close #handle
End Function
Note that for your usage, this will need error handling because of the possibility that URLDownloadToFile still has the file open. I'm assuming that you have some sort of wait mechanism in place (it's a non-blocking function). If not, you need to either use the native callback mechanisms or take a guess and used Application.Wait or something similar.
Example usage:
Private Declare Function URLDownloadToFile Lib "urlmon" _
Alias "URLDownloadToFileA" (ByVal pCaller As Long, _
ByVal szURL As String, ByVal szFileName As String, _
ByVal dwReserved As Long, ByVal lpfnCB As Long) As Long
Private Const S_OK As Long = 0
Sub Examples()
Const TestJpgUrl As String = "https://www.gstatic.com/webp/gallery/1.jpg"
Const TestPngUrl As String = "https://www.gstatic.com/webp/gallery3/1.png"
Dim target As String
target = Environ$("TEMP") & "\test.png"
If URLDownloadToFile(0, TestPngUrl, target, 0, 0) = S_OK Then
'Wait for download to complete - a callback function would be better.
Application.Wait Now + TimeSerial(0, 0, 1)
MsgBox target & ": " & FileIsJpg(target)
End If
Kill target
target = Environ$("TEMP") & "\test.jpg"
If URLDownloadToFile(0, TestJpgUrl, target, 0, 0) = S_OK Then
Application.Wait Now + TimeSerial(0, 0, 1)
MsgBox target & ": " & FileIsJpg(target)
End If
Kill target
End Sub
Note that you can also explicitly test for zip files in a similar way, but I'll leave that as an exercise for the reader.
I've looked all over the place for this and I can't find it; I looked in ADO, and DAO.
Is there a way using VBA to edit the row source property of a combo box on a form in another .mdb file? I have to make this change on a bunch of .mdb files and I'd rather use a script to do it, than to do it one at a time.
Use COM automation to create an Access application session where you open a database, open the target form in design mode, and then alter the target combo box's Row Source.
Public Sub AlterComboRowSource(ByVal pDb As String, _
ByVal pForm As String, _
ByVal pCombo As String, _
ByVal pRowSource As String, _
Optional ByVal pEdit As Boolean = False)
Dim objAccess As Access.Application
Dim frm As Form
Dim cbo As ComboBox
Set objAccess = New Access.Application
objAccess.Visible = True '<- useful while debugging
objAccess.OpenCurrentDatabase pDb, True
objAccess.DoCmd.OpenForm pForm, acDesign
Set frm = objAccess.Forms(pForm)
Set cbo = frm.Controls(pCombo)
Debug.Print cbo.RowSource
If pEdit = True Then
cbo.RowSource = pRowSource
objAccess.DoCmd.Close acForm, pForm, acSaveYes
End If
objAccess.Quit acQuitSaveNone
End Sub
Here is my test procedure, which demonstrates how to use the first procedure:
Public Sub test_AlterComboRowSource()
Const cstrCombo As String = "cmbEmployeeName"
Const cstrForm As String = "frmLogin"
Dim strDbPath As String
Dim strSelect As String
strDbPath = "C:\Users\hans\Documents\Access\Scratch.accdb"
strSelect = "SELECT e.EmployeeID, e.FirstName & ' ' & e.LastName AS [Employee Name] " & _
"FROM tblEmployees AS e " & _
"WHERE e.Inactive=False ORDER BY 2;"
AlterComboRowSource strDbPath, cstrForm, cstrCombo, strSelect, True
End Sub
Those procedures worked as intended when I tested them in Access 2010.
It should be more efficient to do Set objAccess = New Access.Application just once, and then re-use objAccess, opening each of your databases, altering the combo Row Source, and then closing the database.
However since this may be a one-off situation, perhaps you don't care much about execution speed.
I'm developing a call log system, and for tracking purposes the manager wants each user to be logged in upon entry.
I have a module that displays the current logged on user with the code below. I would like for the system to search the table "TBL_Users" for the username and in the text boxes display all the information pertinent to that username. Should that user not be in the database i need to display an error and not allow the user to progress into the system. I'm aware i may need to use a Dlookup but I'm unsure how to code this.
Option Compare Database
Private Declare Function apiGetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Function fOSUserName() As String
' Returns the network login name
Dim lngLen As Long, lngX As Long
Dim strUserName As String
strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If (lngX > 0) Then
fOSUserName = Left$(strUserName, lngLen - 1)
Else
fOSUserName = vbNullString
End If
End Function
After playing around with Dlookup for a while, I need the text-boxes to populate on form load. This is the Dlookup i used.
Private Sub Form_Load()
Windows_Logontxt = fOSUserName()
'agentname = DLookup("Agent_Name", "TBL_Users", "Windows_Logon=" & Windows_Logontxt)
End Sub
It seems Windows_Logon and Windows_Logontxt are text values, so enclose Windows_Logontxt in quotes when you create the string for the third argument to DLookup.
DLookup("Agent_Name", "TBL_Users", "Windows_Logon='" & Windows_Logontxt & "'")
I'm trying to call an event when the user returns focus to the Access application when a specific form is open. The following event doesn't seem to fire up at all.
Private Sub Form_GotFocus()
Call crtListDirectory
End Sub
Does any body have any ideas as to how I could trigger this event to happen, and when/how does the Form_GotFocus event actually get triggered.
thanks in advance for any help
Noel
Access help:
A form can get the focus only if all
visible controls on a form are
disabled, or there are no controls on
the form.
You might like to try Activate.
EDIT re Comments
The only way I can see of doing what you seem to want is with APIs, which is somewhat messy. To demonstrate this you will need a form with two controls Text0 and Text2 (these are the default names). Set the Timer Interval to something suitable, say 2000, and the Timer Event to:
Private Sub Form_Timer()
Dim lngWin As Long
Dim s As String
'This is just a counter to show that the code is running
Me.Text2 = Nz(Me.Text2, 0) + 1
'API
lngWin = GetActiveWindow()
s = GetWinName(lngWin)
If s = "Microsoft Access" Then
If Me.Text0 = "Lost Focus" Then
Me.Text0 = "Focus returned"
End If
Else
Me.Text0 = "Lost Focus"
End If
End Sub
You will now need a module for:
Option Compare Database
Declare Function GetActiveWindow Lib "user32" () As Integer
Declare Function GetWindowText Lib "user32.dll" Alias _
"GetWindowTextA" (ByVal hwnd As Long, ByVal lpString As _
String, ByVal cch As Long) As Long
Declare Function GetWindowTextLength Lib "user32" Alias _
"GetWindowTextLengthA" (ByVal hwnd As Long) As Long
Function GetWinName(hw As Long)
Dim lngText As Long ' receives length of text of title bar
Dim strWinName As String ' receives the text of the title bar
Dim lngWinText As Long ' receives the length of the returned string
lngText = GetWindowTextLength(hw)
strWinName = Space(lngText + 1)
lngWinText = GetWindowText(hw, strWinName, lngText + 1)
strWinName = Left(strWinName, lngWinText)
GetWinName = strWinName
End Function
This is all very, very rough, but it gives you something to mess about with.