Save output from process to Network Drive - vba

We currently output to our SharePoint 2016 site which can be done via a URL option.
With the advent of SP Online, this is no longer possible, so we are going to output the file to a Network Drive and use MS Flow to push into SP Online.
The Access Database has a lot of processes in it which gather data from various places, calculates and then provides this output at the end.
I am not up to speed on all things VBA, but I cannot find a solution to being able to help me with this.
The current script for this is below, which also deletes the previous file to allow for the new one.
How would I go about updating this to output the file to a Network Drive - \\ServerName\Team\Reports\SP_Movement\Files_To_SP
Private Sub Update_ShP() 'Refreshes report in SharePoint Reports folder
'Code to delete report file from ShP
DoCmd.SetWarnings False
Dim xmlhttp
Dim sharepointUrl, sharepointFileName
Dim aFile, bFile As String
Dim LobjXML As Object
' Parent Sharepoint URL
sharepointUrl = "https://dms.company.com/Reports/"
' Sets the report name we want to remove (BoM Data 1)
aFile = "Q_ATP_OUTPUT.xlsx"
Set LobjXML = CreateObject("Microsoft.XMLHTTP")
sharepointFileName = sharepointUrl & aFile
' Removes the data from the server, false means synchronous
LobjXML.Open "DELETE", sharepointFileName, False
' Sends the request to remove the file
LobjXML.send
Set LobjXML = Nothing
DoCmd.RunSavedImportExport "Export-Q_ATP_OUTPUT"
DoCmd.SetWarnings True
End Sub
Thanks

Related

Random File Selector?

It's been years since I've used Visual Basic. I downgraded from 2017 to 2010 (The version I was using while I was in school). I figured VB would be the best way to attempt a solution. (Although I'm sure there are other languages that would do it as well.)
I'm looking to get back into programming. Let me get to the problem.
My friend has an ever growing amount of text documents in a folder, and he wants a program to choose one at random, and open it.
I thought I'd put a TextBox with a Button that would let him open the folder where he stores his files. Then this program would read the number of text files in that folder, and randomly generate a number between one and that number, select, and open the document with its default program (if it's text, notepad; if it's DocX then word.)
I've been sitting at a blinking cursor for 45 minutes. I've gone on YouTube for help with this project.
Any advice, or help you guys can give me? Does this need to be simplified?
That sounds like a reasonable strategy to me.
It might be worth displaying some sort of progress to the user, say by putting the name of current file name being read into the status bar, in case there's a long delay reading the file names due to the large number of files in the folder, and/or a slow-running network drive. If you do this, remember to put a DoEvents into your loop to allow screen updates to display.
There's a separate thread on how to open files in their native handler here.
Hope this helps - good luck!
Option Explicit
Public oFSO As Object
Public arrFiles()
Public lngFiles As Long
Sub Main()
Dim sPath As String
sPath = InputBox("Enter folder path", "Folder path")
' clear starting point
lngFiles = 0
Erase arrFiles
Set oFSO = CreateObject("Scripting.FileSystemObject")
Call recurse(sPath)
Randomize
Dim lngRandomFileNumber As Long
lngRandomFileNumber = CLng(lngFiles * Rnd) + 1
MsgBox "This is random file, that will be opened: " & arrFiles(lngRandomFileNumber)
Call CreateObject("Shell.Application").Open(arrFiles(lngRandomFileNumber))
End Sub
Sub recurse(sPath As String)
Dim oFolder As Object
Dim oSubFolder As Object
Dim oFile As Object
Set oFolder = oFSO.GetFolder(sPath)
'Collect file information
For Each oFile In oFolder.Files
lngFiles = lngFiles + 1
ReDim Preserve arrFiles(lngFiles + 1)
arrFiles(lngFiles) = sPath & "\" & oFile.Name
Next oFile
'looking for all subfolders
For Each oSubFolder In oFolder.SubFolders
'recursive call
Call recurse(oSubFolder.path)
Next oSubFolder
End Sub
You can paste this code in any VBA supporting application (MS Access, MS Excel, MS Word), call VBA editor (Shift + F11) and paste this code. After that press F5 and select Main() function. You'll see prompt to enter folder path, and after that you would get random file path.
I think it should be understandable in practice to see what program do
Updated: #Belladonna mentioned it clearly, to open file in default program.
NB: This code is passes through subfolders also, if you want to exclude subfolders, you should comment the recursive call block in recurce function

Update an excel file by multiple users at same time without opening the file

Scenario
I have an excel file that contains data. There are multiple users accessing the file at the same time.
Problem
There will be problem if multiple users tried to input data to that excel file at the same time due to only one user is allowed to open the file at one time
Question
Is there any way whereby I can update the excel file (Eg: add a value to a cell, delete a value from a cell, find a particular cell etc) without opening it so that multiple users can update it at the same time using excel VBA?
I went to the direction of using shared files. But later found out to be excel shared files are very buggy. If use shared file, excel/macro can be very slow, intermittent crashes and sometime the whole file may get corrupted and could not be opened or repaired afterwards. Also depends on how many users use the file, the file size can grow quite big. So it is best not to use shared workbook. Totally not worth trying. Instead if need multiple users to update data simultaneously, it is better to use some database such as MSAccess, MSSql (Update MSSQL from Excel) etc with excel. For my situation since number of users are less, I didn't use any database, instead put a prompt for the user to wait until the other user close that file. Please see the codes below to check if a file is opened and if so, to prompt user. I got this code from stack overflow itself and I modified to suit my needs.
Call the module TestFileOpened as below.
Sub fileCheck()
Call TestFileOpened(plannerFilePathTemp)
If fileInUse = True Then
Application.ScreenUpdating = True
Exit Sub
End If
End Sub
Here plannerFilePathTemp is the temporary file location of your original file. Whenever an excel file opened, a temp file will be created. For example, your original file location is as below
plannerFilePath = "C:\TEMP\XXX\xxx.xlsx"
Thus your temporary file location will be
plannerFilePathTemp = "C:\TEMP\XXX\~$xxx.xlsx"
or in other words, temporary file name will be ~$xxx.xlsx
The following codes will be called upon Call TestFileOpened(plannerFilePathTemp)
Public fileInUse As Boolean
Sub TestFileOpened(fileOpenedOrNot As String)
Dim Folder As String
Dim FName As String
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(fileOpenedOrNot) Then
fileInUse = True
MsgBox "Database is opened and using by " & GetFileOwner(fileOpenedOrNot) & ". Please wait a few second and click again", vbInformation, "Database in Use"
Else
fileInUse = False
End If
End Sub
Function GetFileOwner(strFileName)
Set objWMIService = GetObject("winmgmts:")
Set objFileSecuritySettings = _
objWMIService.Get("Win32_LogicalFileSecuritySetting='" & strFileName & "'")
intRetVal = objFileSecuritySettings.GetSecurityDescriptor(objSD)
If intRetVal = 0 Then
GetFileOwner = objSD.Owner.Name
Else
GetFileOwner = "Unknown"
End If
End Function
I encountered Out of memory issues also when used shared files. So during the process, I figured out the following methods to minimize memory consumption
Some tips to clear memory

Excel VBA to open Sharepoint folder and create list of hyperlinks for files within

Prior to being asked to migrate to SharePoint, I was using a collection of .xlsm files to set project teams up to manage projects. My Project Manager file included a macro that would go to a designated folder and create hyperlinks for all current project files. I've saved the collection of .xlsm files on SharePoint, but when I run the macro below (which I found here - Thank you!), I receive an error related to the "Set xFolder = xFSO.GetFolder(xPath)" line. Any help would be great. I've read several posting that may have the answer and tried several adjustments to the code, with no luck.
Sub Create_Hyperlinks_for_all_Current_Projects()
Range("B8:D38").Clear
MsgBox "Once you click OK, an explorer box will appear. Select the folder
containing all the CSTPs and then click OK again. HINT: The folder
containing all the CSTPs should be in the same folder this document was in
and should be called ''CSTPs''. Links to all CSTPs will then appear in the
white box on the Manager Menu."
Dim xFSO As Object
Dim xFolder As Object
Dim xFile As Object
Dim xFiDialog As FileDialog
Dim xPath As String
Dim I As Integer
Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
With xFiDialog
.InitialFileName = ThisWorkbook.Path
End With
If xFiDialog.Show = -1 Then
xPath = xFiDialog.SelectedItems(1)
End If
Set xFiDialog = Nothing
If xPath = "" Then Exit Sub
Set xFSO = CreateObject("Scripting.FileSystemObject")
Set xFolder = xFSO.GetFolder(xPath)
For Each xFile In xFolder.Files
I = I + 2
ActiveSheet.Hyperlinks.Add Cells(I + 6, 2), xFile.Path, , , xFile.Name
Next
End Sub
I hope you find the following notes helpful.
They summarize the outcomes from several weeks of frustration.
If you are using SP365,
then the filesystemobject
no longer works very well, if at all.
I had hundreds of macros dependent on the FSO.
These have all worked great up until my organization migrated to SP365 :o(
Now they only work if I manually click
the Open Explorer button, in SP, first.
Opening Explorer provides Win Explorer with the required permissions to access SP.
This in turn provides the FSO with the required permissions to access SP.
But...in my case...FSO only works for a while.
For my first work around...
I rolled out a prototype app, which used a macro to automate
opening IE, opening Win Explorer and initializing permissions for the FSO
All worked great on my machine, for about an hour,
then some kind of timeout took me back to square one.
Colleagues on other machines experienced a range of FSO behaviours.
From all working ok. To having to rerun the connection macro every 30 seconds.
To nothing working at all.
I then invested time trying to update macros to connect to SP as a network drive.
Again, this is a process that I have used for years, up until migration to SP365.
Again, success connecting to SP365 seems to be very machine dependent.
In the end...with respect to my own requirements...
My work around was to create an SP view that lists all files.
Then use the Export to Excel option in SP to create an Excel data query.
Then copy the query into an Excel file that I refer to as Config.xlsx.
Then use Excel RefreshAll to update the list of files, each time a list is required.
Its not very elegant...but, it works ;o)
As I say....I hope this helps you / someone.
Feel free to connect on LinkedIn if you require any followup advice.
Peter,
LinkedIn name DrPeterEHSmee

Change the path of an Excel file linked to Access 2011 with VBA

I was trying something more fancy and did post on accessforums, where I got got no responses and on programmers access, where I got links to more reading material, but which did not help me - probably due to my lack of VBA expertise.
I have done lots of other programming like PHP and Arduino, but VBA is new for me, although I been watching hours of videos, they don't quite cover what I want to do.
After 4 days of researching an failed attempts, I have simplified my approach and I would appreciate some "real" help with actual code.
Scenario:
I have multiple Excel source file with 9 tabs each.
All the source files are in the same directory, (not in the same directory as the database)
Only one source is ever linked.
Each tab of the source file is a linked table within Access.
Objective:
I wish regularly switch source files.
Method:
I want to replace only the connect file property (i.e. the full file path) for each of the 9 sheets/tabs that use the particular file.
The full path must be "picked up" from my form and applied on an event e.g. on closing of form.
Progress:
I have built a form in which I can enter the file name to use and which calculates the full path to the file in question.
I have a button on the form, which is used to close the form.
Code:
Private Sub Form_Close()
Dim dbs As Database
Dim tdf As TableDef
Dim sfl As String
Dim basePath As String
Dim sName As String
Set dbs = CurrentDb
Set sfl = "SourceData_"
Set sName = "JoeSmith"
Set basePath = "D:\Databases\BOM Consolidator\data_source"
' Loop through all tables in the database.
For Each tdf In dbs.TableDefs
If InStr(10, tdf.Connect, sfl, 1) > 10 Then
tdf.Connect = ";DATABASE=" & basePath & sfl & sName & "\" & dbs
Err = 0
On Error Resume Next
tdf.RefreshLink ' Relink the table.
If Err <> 0 Then
End If
End If
Next tdf End Sub
In the above I am entering the path etc directly just to get it working first.
Access froze :(
Help would be appreciated.
Posting this before I try a restart.
After a restart it is not freezing.
It is saying I have a missing object.
The first line is highlighted in yellow, so I assume something must go in the parenthesis, but no idea what.
If it was a function, I would normally put a variable that is not declared inside the function. This being a subroutine, I was not expecting it to ask for something...
Ultimately I will turn it into a function, sothat I can provide the file name.
A clue to what is needed on the first line please...?
Oh also I am using "Code Builder" - is that the correct option to use with closing a form?

Downloading zip file from website using excel vba (if also able to extract the csv from zip file and open it in excel, then even better)

after quite some searching I've not been able to make a macro that would download a .zip file from a specific website. I mean I've been able to find similar problems but have not been able to apply the changes necessary in order for my problem to be solved. The website that contains the zip files is: https://nio.gov.si/nio/data/prvic+registrirana+vozila+v+letu+2014+po+mesecih, under table header "Priponke" are the files. For example: December 2014 (959 kb), November 2014 (1061 kb), ... The url that downloads the zip file for December 2014 is "cms/download/document/a7605005b6879fe5f7dbab6d60d4ae787dbced6b-1422453741279". I thank you in advance and am awaiting your reply.
My current code is:
Public Sub DownloadFile()
Dim objWHTTP As Object
Dim strPath As String
Dim arrData() As Byte
Dim lngFreeFile As Long
On Error Resume Next
Set objWHTTP = CreateObject("WinHTTP.WinHTTPrequest.5")
If Err.Number <> 0 Then
Set objWHTTP = CreateObject("WinHTTP.WinHTTPrequest.5.1")
End If
On Error GoTo 0
strPath = "https://nio.gov.si/nio/data/prvic+registrirana+vozila+v+letu+2014+po+mesecih"
strPath = "https://nio.gov.si/nio/cms/download/document/a7605005b6879fe5f7dbab6d60d4ae787dbced6b-1422453741279"
objWHTTP.Open "GET", strPath, False
objWHTTP.send
arrData = objWHTTP.responseBody
If Len(Dir("C:\FootieFile", vbDirectory)) = 0 Then
MkDir "C:\FootieFile"
End If
lngFreeFile = FreeFile
Open "C:\FootieFile\MyFile.xml" For Binary Access Write As #lngFreeFile
Put #lngFreeFile, 1, arrData
Close #lngFreeFile
Set objWHTTP = Nothing
Erase arrData
End Sub
Kind regards
You need to download a binary file, and save it. This can be done using the MSXML2.XMLHTTP60 object to download, and ADODB.Stream object for saving.
See e.g. http://www.motobit.com/tips/detpg_read-write-binary-files/
I've used this succesfully to download JPG files from a server and display them in an MS Access front end.
Also I hope you realize you can't start your url with 'cms', as you will need the fully qualified domain name plus resource (aka http:// etc)
Also be careful with unicode data. For that you might need to use StrConv(). Check after downloading that the size of your file is the same as it is on the server.