ms access linked image relitive path - image

I have an Image object.
I have the Picture type set to linked, so I can change the picture if I want.
I have the Picture property set to the picture name.
I would think that access would use relitive addressing and simple looking in the current directory for the image. But it does not and I get an error telling me it cannot find the picture.
Anyone have a solution? (Other than setting the Picture type to embedded or using the full file address?)
Thanks!
Update:
Tried this:
Private Sub Form_Load()
Dim file As String
file = CurrentDb().Name
file = Replace(file, ".mdb", ".bmp")
Me.Image46.Picture = file
End Sub
It works, except I still get the error message. I click O.K. and it works. Just need the error message to go away.
SOLUTION: Use the above code (or the code posted in the answer below) and then set the 'picture type' to "embedded" and then delete the 'picture' field so that it says "(none)".
Save and run.
It should work.
THANKS!

You could set the property on the forms OnLoad event like this
Me.imgMy_image.picture=getDBPath & “mypicture.bmp”
Here is the getDBPath function
Public Function GetDBPath() As String
Dim strFullPath As String
Dim I As Integer
strFullPath = CurrentDb().Name
For I = Len(strFullPath) To 1 Step -1
If Mid(strFullPath, I, 1) = "\" Then
GetDBPath = Left(strFullPath, I)
Exit For
End If
Next
End Function
Before anyone comments yes I know in access 2000 and above you can use currentproject.path but I’m stuck in the land that time forgot so need that custom function, it still works with later versions of access

Current folder depends of the way you open database in Access. At least, if you open it thru "File-Open", current folder changes to the folder of MDB file. But if you open via double-clicking MDB in explorer, it does not.

Related

Delete Word Document from location - VB UFT

As suggested in the title, it looks like a simple question but i didn't find any solution so far.
So i would like to delete a Word document from a file system, share, file explorer; so any location.
I didn't find a way to deal with that concern.
I've tried simple DeleteFile function but it seems it doesn't handle word file.
Function DeleteAFile(filespec)
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile(filespec)
End Function
The same i tried creating a oWord object ( an instance of a COM component ) but there is no delete method or event available.
Set oWord = CreateObject("Word.Application")
oWord.'No method nor event for delete action
So i'm blocked.
Is someone having a solution, it would be helpful.
In VBA or VB.Net the simple command is:
Kill(Path and Filename)
Based on additional information provided in the comments that only VBScript can now be used. You should consider two factors. The files you are trying to delete are Read Only and you have to then use the Force option on the DeleteFile method. The other is that your routine is receiving some error condition and thus the DeleteFile method is being stopped. You should add error checking to your routine.
For further information on the FileDelete method see the following:
https://learn.microsoft.com/en-us/office/vba/language/reference/user-interface-help/deletefile-method

How to get rid of prompt on quitting MS ACCESS

I am running a Sub procedure stored in an ACCESS database using VBScript. The procedure queries the database and exports/saves a CSV file.
My problem is that the script successfully opens the database, runs the procedure but then leaves ACCESS open because ACCESS opens a prompt asking "Are you sure that you want to leave ACCESS" (rather its equivalent in German). I want it to close without interaction.
The basic idea of this script is to run it via the Windows Task Scheduler. (Which does not work right now but that is another question.)
Here is the part of my VBScript dealing with the ACCESS database:
Dim objAccess
Set objAccess = createObject("Access.Application")
objAccess.OpenCurrentDataBase("C:\FiselTools\Allgemein\Scripte\Pellenc-CopyBelegarchiv3.accdb")
objAccess.Run "CopyBelegarchiv"
objAccess.Quit acQuitSaveAll
Set objAccess = Nothing
Using this script manually, it does open the database, export the file, finally executes the part following the code from above - so only closing ACCESS does not work and my guess is that it's not a problem with the script or the procedure but the ACCESS.
Erik A basically gave the right answer: there was some VBA code that is responsible for this prompt (see below). It was part of the primary form.
So in this case I found two possible solutions:
Do not display/show the form (which worked for me as I made a copy of the file dedicated for just this purpose).
If you need the form then you might need to delete the VBA code.
Private Sub Form_Unload(Cancel As Integer)
Dim Answer As Variant
Answer = MsgBox("Wollen Sie die Anwendung wirklich beenden?" & vbNewLine & vbNewLine & "Nicht gespeicherte Änderungen gehen dabei möglicherweise verloren", vbQuestion + vbYesNo + vbDefaultButton2)
If Answer = vbNo Then
Cancel = True
Else
DoCmd.Quit acQuitSaveNone
End If
End Sub
Since it is part of the Access class object of the form that is configured to be displayed on opening the ACCESS database and I do not need the form when I run the procedure via VBScript I simply changed the database to not display any form when the database is opened.
Some day I will remove any form, query, and any other object not needed from this special copy of the database that I don't need to run from VBScript.
Thanks!

Creating a view and agent in multiple databases

The problem I am encountering is that some of the messages are not accessible by the user ID file, I would like to skip these files instead of the agent crashing out. The error message received is as follows:
Using the view approach if this happened I was able to delete the document temporarily and re-run the agent but if there is a way to skip documents it would be a great help.
Thanks for the help guys.
Ok I have amended the code to a point where I am almost comfortable with it.
Sub Initialize
Dim s As New notessession
Dim db As notesdatabase
Dim view As notesview
Dim doc As notesdocument
Dim nextdoc As notesdocument
Set db = s.currentdatabase
If view Is Nothing Then
Set view = db.CreateView("Encrypted",{Encrypt="1"})
End If
Set doc = view.getfirstdocument
On Error Goto ErrorHandler
While Not doc Is Nothing
nextDocument:
Set nextdoc = view.getnextdocument(doc)
'The below loop is mandatory to ensure that all $File entries are unecrypted
Forall i In doc.items
If i.isencrypted Then
i.isencrypted=False
End If
End Forall
'Must have at least 1 field encrypted in order to call Encrypt method
Dim temp As New NotesItem(doc,"tempjunk","temp")
temp.IsEncrypted=True
Call doc.encrypt
Call doc.save(True, False)
'This portion can now remove the fields relative to encrypting the
'single token encrypted field.
Call doc.removeitem("$Seal")
Call doc.removeitem("$SealData")
Call doc.removeitem("SecretEncryptionKeys")
Call doc.removeitem("Encrypt")
Call doc.removeItem("tempjunk")
Call doc.save(True, False)
Set doc = nextdoc
Wend
Exit Sub
ErrorHandler:
On Error Resume nextDocument
Exit Sub
End Sub
The error handling is not playing nice;
On Error Resume nextDocument is showing up as an error.
I have tried suppressing all of the error warnings which seems to attempt to strip the encryption but I think they body of the messages is being destroyed as a result.
It is no problem to create an agent in a container database and let that agent access documents in all "target" databases and modify them accordingly - No need to copy that agent to all databases.
Only restriction: If the databases are on another server, then on the server security tab of the target server you have to enter the server with the container database as trusted server.
AND: If your agent runs longer than the allowed maximum run time for agents on the server, then it will be killed prematurely.
There is no need to create views in the target databases, you can use NotesDatabase.Search() to get the corresponding documents in the databases...
You can create views by copying them from another database. Say you create a view "Encrypted" in your db with the agent.
Then add a piece of code to get a handle of this view as a NotesDocument:
Dim dbThis As NotesDatabase
Dim viewTemplate As NotesView
Dim docView As NotesDocument
Set dbThis = s.currentDatabase
Set viewTemplate = dbThis.getView("Encrypted")
Set docView = dbThis.Getdocumentbyunid(viewTemplate.Universalid)
In the agent loop, test if view Encrypted exists, if not copy the "view template":
Set view = db.getview("Encrypted")
If view Is Nothing Then
Call docView.Copytodatabase(db)
Set view = db.getview("Encrypted")
End If
Finally, if you insist, a similar procedure might be used to copy the agent to all databases, but for me the idea of running the agent in one db sounds better.
Edited: In the view of full disclosure - of course you can create a view (I guess that was the original question).
If view Is Nothing Then
Set view = db.Createview("Encrypted", {Encrypt="1"})
End If
Or do one-shot dbSearch suggested by Torsten, with a good re-mark of Richard - if you intend to run your code several times - say if encrypted documents might get created again or re-encrypted, rather go for the view.
My method is a bit old fashioned (pre-dates availability of createView) and works well if you need more than selection formula, so you can pre-build a complicated view for re-use.
Performance-wise: whatever method you will choose either creating view using createView or copying from other db or doing dbSearch there is going to be a certain slow-down while the view gets built or dbSearch executes. Karl-Henry's approach will avoid this search/view build, but will be relatively slow if there are not many encrypted documents.
Whichever method you choose - here is a small tip to boost performance. Make your loops like this to release memory as you go; for example, assuming Karl-Henry's approach:
Dim doc1 as NotesDocument
Set doc = col.GetFirstDocument()
Do Until doc Is Nothing
Set doc1 = col.GetNextDocument(doc)
formname = doc.GetItemValue("Form")(0)
If IsElement(exclude(formname))=False Then
Call RemoveEncryption(doc) '*** Your function to remove encryption
End If
' releasing memory when processing thousands of documents improves performance and avoids crashes
Delete doc
Set doc = doc1
Loop
Now again, as you are talking only about migration (so one shot) of 20+ databases, the speed or implementation details should not be that critical.
If you have to process all (or almost all) documents in each database, you can use db.AllDocuments. It is more efficient than using db.Search() with an #All formula.
If you want to exclude certain documents, perhaps based on the form name, I would build a list of forms to exclude, and then use IsElement to check each document being processed against that list.
Dim exclude List As Boolean
exclude("FormA")=True
exclude("FormB")=True
Set col = db.AllDocuments
Set doc = col.GetFirstDocument()
Do Until doc Is Nothing
formname = doc.GetItemValue("Form")(0)
If IsElement(exclude(formname))=False Then
Call RemoveEncryption(doc) '*** Your function to remove encryption
End If
Set doc = col.GetNextDocument(doc)
Loop
Something like that. By the way, you can create the list as any data type. I just choose Boolean as it is a small data type, and that it makes the code easier to read. The IsElement() function just check if the element exists, it does not use the value you set.
You would wrap the code above in a function and call it once per database.
Appended answer, based on additional info in original question:
That should not be hard, just add error handling to your code.
Before you start to loop throung the document:
On Error Goto errHandler
Before you get the next document in the loop:
nextDocument:
At the end of your code:
Exit Sub
errHandler:
Resume nextDocument
End Sub
Try that.

"Method or Data Member Not Found" When Trying to Execute Database Code

I have a test project I'm using to familiarise myself with VB6. Just a listbox, a button to get info, and a button to clear info:
Code:
Option Explicit
Private Sub btnGet_Click()
lstResults.DataSource = GetMenuItems
End Sub
Private Sub btnClear_Click()
lstResults.Clear
End Sub
Public Function GetMenuItems() As ADODB.Recordset
Dim rs As ADODB.Recordset
Dim conn As New ADODB.Connection
conn.ConnectionString = "File Name=C:\connString.udl"
Dim cmd As New ADODB.Command
Set cmd.ActiveConnection = conn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "dbo.GetMenuItems"
Set rs = cmd.Execute()
GetMenuItems = rs
End Function
The following error appears when I click the Get Items button (btnGet):
Compile Error: Method or Data Member Not Found
At first I thought it might be something to do with the event/button, that some sort of binding between them wasn't present. But just putting in something like "MsgBox("Hello")" works fine. Yet it doesn't even seems to get to the line where the GetMenuItems function is called before throwing the error.
This being my first whirl with VB, I'm a little stumped.
EDIT - I've had a look at the UDL file I was using too. Tested that and its connecting ok on its own.
In Sub btnGet_Click, use
Set lstResults.DataSource = GetMenuItems
Assigning object references without using Set is hardly ever the right thing to do. For what it's worth, omitting Set references the left-hand side's default property; this was part of VB6 (OK, VB4, when classes were introduced) as a help to VB3 programmers, before there were such things as objects. Whatever kind of object lstResults.DataSource returns likely does not have a default property, leading to the "Method or data member not found" error.
You've got a private sub btnGet_Click() calling a public function GetMenuItems(), which may cause problems.
Also I'm not sure you can use a udl as the connection string. Instead, open the UDL (you may need to change the file extension to .txt temporarily), take the connection string out, and use that in place of the file name.
Also, check the stored procedure exists dbo.GetMenuItems

Add item to Error List in Macro

I want to notify the user of the macro if something went wrong during the execution of the macro. I was wondering if it would be possible to add an item to the Visual Studio error list?
It is possible to do so from within an AddIn (like here), but I would like to do the same thing from a macro.
Edit
To further clarify what i want to achive, here is the sample from the Samples macro library (Alt+F8 -> Samples -> Utilities -> SaveView())
Sub SaveView()
Dim name As String
name = InputBox("Enter the name you want to save as:", "Save window layout")
If (name = "") Then
MsgBox("Empty string, enter a valid name.")
Else
DTE.WindowConfigurations.Add(name)
End If
End Sub
Instead of the MsgBox("...") alert I want to put the error into the VS error list.
You can add an item in the Task List easily from your macro. Just use the AddTaskToList method from that article and change m_objDTE to DTE. I've tried it and it worked.
However, adding the item in Error List, is probably impossible. You need to call VS services, see how adding an error is done in an add-in. I created a macro from this code and it didn't work. In general, VS services don't work in macros. I was able to create ErrorListProvider successfully. I could access it's methods and properties. But calling ErrorListProvider.Task.Add caused COM exception. If you want to play with it, several notes:
As described in the article, you need to get 4 assemblies out of the GAC e.g. to c:\dlls\ directory. Since Macros IDE doesn't allow you to browse when you Add Reference, you need to copy these dlls into ...\Microsoft Visual Studio 10.0\Common7\IDE\PublicAssemblies directory (change the 10.0 to your VS version). Then, when you Add Reference in Macros IDE, you should see the assemblies.
The GetService function always returned Nothing. Add the following field to the class:
Private serviceProvider As IServiceProvider = New Microsoft.VisualStudio.Shell.ServiceProvider(CType(DTE, Microsoft.VisualStudio.OLE.Interop.IServiceProvider))
and in GetService function change line:
objService = Microsoft.VisualStudio.Shell.Package.GetGlobalService(serviceType)
to
objService = serviceProvider.GetService(serviceType)
As I wrote, everything seems OK then but ErrorListProvider.Task.Add fails.
I think that for your situation outputting something to your own output pane would be more suitable. The error list is generally used for errors within the project the user is working on, not for errors caused by running macros. Especially when someone says it can't be done. :)
Outputting to your own output pane is pretty easy:
DTE.Windows.Item(Constants.vsWindowKindOutput).Activate()
Dim panes As OutputWindowPanes = window.OutputWindowPanes
Dim my_pane As OutputWindowPane
Try
my_pane = panes.Item("SaveView")
Catch exception As System.ArgumentException
my_pane = panes.Add("SaveView")
End Try
my_pane.Activate()
my_pane.OutputString("Empty string, enter a valid name." + vbCrLf)
Hope this helps.
Cheers,
Sebastiaan
Is this not what you want?
HOWTO: Add an error with navigation to the Error List from a Visual Studio add-in
http://www.mztools.com/articles/2008/MZ2008022.aspx

Resources