Access Shared Network Folder - excel

I need to access via VBA a folder hosted on a Network File Server. The folder is accessible in writing only via a Service Account (different from normal user accounts) for which I do have username and password.
Via the UI I can see that folder and map it as a local drive but in order to access it in writing I need to log off from Windows and logon via the Service Account.
Is there any way to access the network folder during a normal user session but hardcoding username and pwd in the VBA code?
I did try mapping the folder as local drive with:
Set WshNetwork = CreateObject("WScript.Network")
WshNetwork.MapNetworkDrive "S:", "\\corp-server\HostingFolder", False, Username, pwd
but did not work ("S" drive was not mapped). If instead I do the same but without providing Username and password:
Set WshNetwork = CreateObject("WScript.Network")
WshNetwork.MapNetworkDrive "S:", "\\corp-server\HostingFolder"
it works perfectly.
Wondering now if what I am trying to do is actually possible? If not, is there any alternative?
Thanks

You might find this answer of value in your testing.
Essentially, I would check a couple things...
Make sure you are not already connected to this resource using the current logged in user. If you are, you might get an error message like the following:
Make sure you are using the domain\username syntax in your username.
Otherwise I think you are the right track. I put together some sample code based on the link above, and was able to successfully connect to a network share under a different user name and iterate through a list of files.
(Note the tip that you don't actually have to map a drive to establish a connection.)
The following code is a really quick (working) VBA implementation of the sample listed at Access network share from within VBScript eg FileSystemObject
Public Sub TestNetShareName()
Dim NetworkObject As Object
Dim FSO As Object
Dim Directory As Object
Dim Filename As Object
Dim ServerShare As String
Dim UserName As String
Dim Password As String
ServerShare = "\\corp-server\HostingFolder"
UserName = "mydomain\myuser"
Password = "freddie123"
Set NetworkObject = CreateObject("WScript.Network")
Set FSO = CreateObject("Scripting.FileSystemObject")
NetworkObject.MapNetworkDrive "", ServerShare, False, UserName, Password
Set Directory = FSO.GetFolder(ServerShare)
For Each Filename In Directory.Files
Debug.Print Filename.Name
Next
Set Filename = Nothing
Set Directory = Nothing
Set FSO = Nothing
NetworkObject.RemoveNetworkDrive ServerShare, True, False
Set NetworkObject = Nothing
End Sub

Related

How to access file resource via LotusScript

I want to access and use shared file. I considered these approaches:
1. Store the attachment in Notes Document
2. Store the attachment in database profile
but in both cases I will need to add extra UI design elements (form, view... )
So the easiest way to maintain it - use db Resources (images or files).
I need to create LotusSrcit action that would access the file from db Resources and attach it into new NotesDocument that will be sent as an email.
1 and #2 easy to implement. But how can I access certain file resource from db Resources?
You can access file or image resources using the NotesNoteCollection class. However, since Notes stores the attached files or images in its own, internal format, it is not easy -- if at all possible -- to access those attachments using pure LotusScript.
A workaround that I found useful is to attach the file to an Applet resource, where it can be accessed using pure LotusScript; see sample code below.
Dim sn As New NotesSession()
Dim db as NotesDatabase
Dim nc As NotesNoteCollection
Dim designNote As NotesDocument
Dim eo As NotesEmbeddedObject
Dim noteID$, myFileName$
myFileName = "foobar.txt"
Set db = sn.CurrentDatabase
Set nc = db.CreateNoteCollection(False)
nc.SelectJavaResources = True 'select all Applet resources
nc.SelectionFormula = {$TITLE="} + myFileName + {"} 'assuming the Applet resource has the same name as the file
Call nc.BuildCollection()
noteID = nc.GetFirstNoteID()
Do Until Len(noteID) = 0
Set designNote = db.GetDocumentByID(noteID)
Set eo = designNote.GetAttachment(myFileName)
If Not (eo Is Nothing) Then
'----- your code goes here -----
Exit Do
End If
noteID = nc.GetNextNoteID(noteID)
Loop
I'm making two assumptions here:
The name of the file you want to access is known ("foobar.txt" in the sample code). This is necessary, since otherwise you won't be able to access the attachment.
The Applet resource has the same name as the attached file. Not necessary, but convenient for being able to filter the NotesNoteCollection by the very name of the attached file.

User Defined Functions (UDF) from Access Query to Excel using VBA OpenRecordset failed - Undefined Function

How do I get the results of a query from Access into Excel if it has a UDF?
I receive the following error: "Run-time error '3085': Undefined function 'XXXX' in expression". The error occurs when opening an (access query) recordset from Excel VBA. The query being opened has a user defined function (UDF) which is triggering the error.
The code is in Excel Office 365. The query is in Access Office 365.
I have successfully utilized the query being called (and others with the UDFs) for about twelve months, and "suddenly" it is not working any more. I have googled and tested many options with no success.
Most threads say it can't be done, or to not use a udf but try a built-in that works. I am challenging those responses because it has worked previously. The main udf I am using is one called "iMax" which is written about in other posts. It functions like max() in Excel. (No max(x,y) function in Access)
I have also seen threads that suggest executing this in two steps: 1 - change the query to a make table query. 2 - pull the table results into Excel. While I could maybe get away with this (after much rework), it would result in me making many temporary tables with thousands and thousands of rows and doesn't seem very slick.
I have compiled vba and compacted the db with no impact to my problem.
As a long shot I created a dummy database with a simple udf public function that returned the number 1, a simple query that returns three records and a field for the function results. This gets the same error when pulling into Excel.
Sub RunQuery()
Dim MyDatabase As dao.Database
Dim qdf As dao.QueryDef
Dim rs As dao.Recordset
Dim qryname As object
Dim SheetName As String
Set MyDatabase = DBEngine.OpenDatabase _
("SomePath\SomeFilename.accdb")
For Each qryname In Range("SomeRange")
Set rs = MyDatabase.OpenRecordset(qryname) '<<<ERROR IS HERE
SheetName = "SomeSheetName"
With Sheets(SheetName)
.ListObjects(SomeTableName).DataBodyRange.Rows.ClearContents
.Range("A2").CopyFromRecordset rs
End With
Set rs = Nothing
Set qdf = Nothing
Next qryname
End Sub
For all queries in the For loop that do not have a udf, the results are pulled and dumped into a series of tables in Excel. Any query with a udf errors at the "Set rs = Mydatabase.OpenRecordset(qryname)
If you run the query within an Access application session, as Gustav suggested, the expression service can handle the UDF in your query.
Here is a quick tested Excel VBA snippet which pulls data from a query which includes a UDF:
Const cstrDbFile As String = "C:\share\Access\Database2.accdb"
Dim objAccess As Object
Dim rs As Object
Dim ws As Worksheet
Dim strSelect As String
Set objAccess = CreateObject("Access.Application")
objAccess.Visible = True ' useful during testing '
objAccess.OpenCurrentDatabase "C:\share\Access\Database2.accdb"
strSelect = "SELECT ID, DummyFunction('a', '', 'c') FROM Dual;"
Set rs = objAccess.CurrentDb.OpenRecordset(strSelect)
If Not rs.EOF Then
Set ws = ThisWorkbook.Sheets("Sheet1")
ws.Range("A1").CopyFromRecordset rs
End If
rs.Close
objAccess.Quit
Most threads say it can't be done,
and they are right.
Your only option is to use automation to open an instance of Access and, within this, run the query.
Well, as noted, most are saying this should not work.
However, if you are 100% sure it was and did work at one time?
You need to set the "sandbox" mode of the JET (now ACE) database engine.
The expression service normally does not allow evaluation of VBA functions as a security setting to prevent SQL injection, or code running outside of Access to allow SQL to run + call VBA functions. At one time, this feature did default to "on", but now the default is set to access only.
You have to set the folder where Access application as trusted. This should allow the VBA functions to now work. so, make sure you set the folder as trusted.
If the location (folder) where your access application is NOT trusted, then Access will use sandbox mode, and VBA in the SQL will not run.
If the location is trusted, THEN access uses the registry setting on your computer.
My bets are that the location is not trusted - so you always get sandbox mode for SQL in Access.
If you are 100% sure that the folder location is set as trusted in Access, and you still receive the errors, then you have to change the registry setting for Access "sandbox" mode.
The setting in the registry is outlined here:
https://support.office.com/en-us/article/Turn-sandbox-mode-on-or-off-to-disable-macros-8CC7BAD8-38C2-4A7A-A604-43E9A7BBC4FB
The registry settings are:
for x32 bit access:
Software\Microsoft\Office\ClickToRun\Registry\Machine\Software\
Wow6432Node\Microsoft\Office\16.0\Access Connectivity Engine\Engines
The above is for Office 2016
14 = 2010
15 = 2013
16 = 2016
The key value for sandbox mode is:
0 to 3
0 Sandbox mode is disabled at all times.
1 Sandbox mode is used for Access, but not for non-Access programs.
2 Sandbox mode is used for non-Access programs, but not for Access.
3 Sandbox mode is used at all times. This is the default value, set when you install Access
So, from above, you want a setting of 0.

Accessing outlook message body with excel vba: error 287

We have a lot of emails saved to a folder on the file system to be processed by extracting text from the message bodies. Office 2010.
Dim app As Object
Dim msg As Object
dim msg_body as string
Set app = New Outlook.Application
Set msg = app.CreateItemFromTemplate("c:\path\to\message.msg")
msg_body = msg.body
This code works fine on my laptop however when I use it on the work network it gives error '287'.
While debugging I noticed that I can view msg msg.display and even change the body with msg.body = "some text". However I cannot read the message body. Also tried msg.HTMLbody which could not be read.
The most probable cause is your company's policies.
Check this registry key to solve the SaveAs (change the 16 to your office version).
hkcu\software\policies\microsoft\office\16.0\outlook\security\promptoomsaveas
You can change the value to 2, or ask your system administrator to create a new GPO.
More information on this and other security configurations in:
https://support.microsoft.com/en-za/help/926512/information-for-administrators-about-e-mail-security-settings-in-outlo

LotusScript:Agents on schedule does not run DbLookup

I'm writing a LotusScript agent that runs on schedule. In the script, there is a line that
goes something like
Dim eval as Variant
eval = Evaluate({#DbLookup( "": ""; "SVR1": "db.nsf"; "aView"; "KeyValue"; 4})
Where SVR1 is the servername, db.nsf is the database, aView is the view and KeyValue is the key used to access the desired record(s). The last number 4 is the column number of the view that we want the value from.
I've been doing this for awhile and no problems. Only now does the script seem not to run on schedule. It works if i run it manually via the designer. I've used NotesLog to do debug and i noticed the agents stops right at that line. The db it is looking up is on another server.
What is causing this script to fail?
Seems that you are trying to connect to the server, different than the agent is running on.
In the old lotus versions there was a strict rule, you was not able to connect to another server in the scheduled agent.
I.e if you ran your scheduled agent on the server: SRV0 you was able only to get information from the server SRV0.
Later (if I recall correctly in Domino 6.0 and later) the new term included: trusted server.
So, if you want to access another server from your scheduled agents you need to register this server as a trusted server.
To add server to trusted servers list, open your server document in the server address book.
Go to Security tab and specify trusted servers in the corresponding field.
I recommend to not use the Evaluate in a such way. Instead of this is better to use native LotusScript objects like NotesDatabase, NotesView and so on:
Dim db As New NotesDatabase("", "")
Dim view As NotesView
Dim vc As NotesViewEntryCollection
Dim entry As NotesViewEntry
Dim eval as Variant
Call db.Open("SRV1/OrgUnit/Organization", "db.nsf")
Set view = db.GetView("aView")
Set vc = view.GetAllEntriesByKey("KeyValue", True)
If vc.Count = 0 Then
Exit Sub
End If
Redim eval(vc.Count - 1)
Set entry = vc.GetFirstEntry
index% = -1
Do While Not entry is Nothing
index% = index% + 1
eval(index%) = entry.ColumnValues(3)
Set entry = vc.GetNextEntry(entry)
Loop

How do I remove IIS based components from InstallShield in an upgrade?

In trying to create a major upgrade existing web applications with InstallShield as suggested here I have created a new application pool, but can't create a new IIS application. However while the new install creates the new pool, it doesn't change the existing virtual directory to use the new pool. The logs say virtual directory already exists and leaves it at that.
Is it possible to get the install to change an existing component, or simply how do I delete the virtual directory component since the remove files table expects a directory?
Thanks
Ended up achieving this by
Created a Property called WEBSITENAME with the value of the website name from the String Editor table (this is for reuse)
Created a VBscript custom action, to run after RemoveFolders with the following condition: IIS_VERSION <= "#6" and NOT INSTALLED
The code is:
Dim objWebServer
Dim objVirtualDir
Dim strAppName
Dim intASPSessionTimeout
Dim SubVirtDir
On Error Resume Next
CreateApplication = ERROR_SUCCESS
strAppName = Session.Property("WEBSITENAME")
SubVirtDir = "/" + strAppName
intASPSessionTimeout = 120
Set objWebServer = GetObject("IIS://localhost/W3SVC/1/Root")
'Delete the Virtual subdirectory
Set objVirtualDir = objWebServer.Delete("IISWebVirtualDir", SubVirtDir)
Set objVirtualDir = objWebServer.Delete("IISWebVirtualDir", strAppName)
This does what I needed to do. Now I need to figure out a similar way to conditionally Enable32bitAppOnWin64!

Resources