VBA - Uploading a file to sharepoint document library stopped working - vba

Our SharePoint site used to be on-prem, and it migrated to the one hosted on the cloud.
We had the following VBA code to upload a file to its document library, and it stopped working although we have the correct new URL. It doesn't throw any error, but it just doesn't upload the file. Is there another way do upload a file? Thank you very much.
' To read source files as byte
Dim binaryByte() As Byte
Dim binaryByteData As Variant
'Get lngFileLength for binarybyte initialization.
Dim lngFileLength As Long
'Initilizate the scripting object for getting folder information.
Dim objFSO As Scripting.FileSystemObject
Set objFSO = New Scripting.FileSystemObject
' Initialize the xmlhttp object
Dim LobjXML As Object
Set LobjXML = CreateObject("Microsoft.XMLHTTP")
'Set sharepoint URL from tbl_Lookup
sSharePointURL = ELookup("SharePointFolderURLPath", "tbl_Lookup")
'Get path of file to publish
sFilePath = CurrentProject.Path & "\Published"
' Get the filename
sFileNameWithPath = sFilePath & "\" & ELookup("FrontEndFileNameAccdb", "tbl_Lookup")
'Array length identification
lngFileLength = FileLen(sFileNameWithPath) - 1
'Reinitialize the byte array
ReDim binaryByte(lngFileLength)
'Open file binary consumption
Open sFileNameWithPath For Binary As #1
Get #1, , binaryByte
Close #1
' Convert to variant to upload.
binaryByteData = binaryByte
'Destination URL
sDestinationURL = sSharePointURL & ELookup("FrontEndFileNameAccdb", "tbl_Lookup")
' Upload the data to the server, false means synchronous.
LobjXML.Open "PUT", sDestinationURL, False
Set LobjXML = Nothing
Set objFSO = Nothing

Related

VBA Read a texts files: permission denied

I have a folder contain texts files . The text is presented as below :
NAME Number Mail Date
xx 1 zz //
and I want to write a vba code that read all the text files and search for an information "NAME" to replace it with "name"and then save the modifications .
I did the code below , but I have an error 70 permission denied in Set f = FSO.OpenTextFile(Fichier, forWriting, True) ,
could you help me ?
Sub Sample()
dim fso=createobject("scripting.filesystemObject")
dim f
dim path as string
dim file_txt as string
path= "C:\Users\Folder\Fileshere\"
file_txt= Dir(path & "*.*")
Do While Len(file_txt) > 0
'Set objfile = FSO.CreateTextFile(path & file_txt)
Set f = FSO.OpenTextFile(file_txt, ForReading)
While Not f.AtEndOfStream
Namechange = f.ReadAll
Wend
Namechange = Replace(Namechange , "NAME", "name")
Set f = FSO.OpenTextFile(file_txt, forWriting, True)
f.Write Namechange
file_txt=dir()
loop
end sub
I'd rewrite using a bit more of the FileSystemObject functionality rather than using Dir() personally, but that's open to your own choice. The key issue I think you are having is that you have opened the file for reading and then immediately tried to open it for writing while the TextStream object is still in memory, and locking the file. This is why you are getting "Permission denied". To quote from a TechNet Article:
Opening Text Files
Working with text files is a three-step process.
Before you can do anything else, you must open the text file. This can
be done either by opening an existing file or by creating a new text
file. (When you create a new file, that file is automatically opened
and ready for use.) Either approach returns a reference to the
TextStream object. After you have a reference to the TextStream
object, you can either read from or write to the file. However, you
cannot simultaneously read from and write to the same file. In other
words, you cannot open a file, read the contents, and then write
additional data to the file, all in the same operation. Instead, you
must read the contents, close the file, and then reopen and write the
additional data. When you open an existing text file, the file can be
opened either for reading or for writing. When you create a new text
file, the file is open only for writing, if for no other reason than
that there is no content to read. Finally, you should always close a
text file. Although this is not required (the file will generally be
closed as soon as the script terminates), it is good programming
practice.
My code should work for your requirements. I've removed the While loop from the middle as if you are using ReadAll then you don't need to loop over the text.
Sub MySub()
Dim fso
Set fso = CreateObject("scripting.filesystemObject")
Dim file, folder
Dim path As String
Dim file_txt As String
path = "C:\users\folders\fileshere\"
Set folder = fso.GetFolder(path)
For Each file In folder.Files
Set file = fso.OpenTextFile(file.Path, 1)
Namechange = file.ReadAll
file.Close
Namechange = Replace(Namechange, "NAME", "name")
Set file = fso.OpenTextFile(file.Path, 2, True)
file.Write Namechange
file.Close
Next
End Sub
If you have any difficulties or would like further explanation of the above, let me know.
Some minor changes and it worked for me. Please change the path as per your own requirement in following code:
Sub change_txt()
Dim fso As Object
Set fso = CreateObject("scripting.filesystemObject")
Dim f
Dim path As String
Dim file_txt As String
path = "D:\Folder\Fileshare\"
file_txt = Dir(path & "*.*")
Do While Len(file_txt) > 0
'Set objfile = FSO.CreateTextFile(path & file_txt)
Set f = fso.opentextfile(path & file_txt, 1)
While Not f.AtEndOfStream
Namechange = f.ReadAll
Wend
Namechange = Replace(Namechange, "NAME", "name")
Set f = fso.opentextfile(path & file_txt, 2)
f.Write Namechange
file_txt = Dir()
Loop
End Sub

Export single CATIA body from CATPart as stl using VBA macro

Is it possible to export a single CATIA body as STL without creating a separate part with it?
For the time being, I have coded a script which loops through the CATParts present in a folder, fetches the contained bodies and create a single CATPart with each of them and export into stl format.
Dim output_stl_path_HD As String
Dim output_stl_path_MD As String
Dim output_stl_path_SD As String
Dim output_stl_path_via_points As String
Dim output_transformations_path As String
Dim input_path As String
Sub CATMain()
'Path for output file
input_path = CATIA.ActiveDocument.path + "\"
Dim it As Integer
Dim prod As Product
Dim t_p_ref(11)
'List of part names to export
Dim list As Collection
Set list = New Collection
'GET LIST OF CATPART IN FOLDER
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(input_path)
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'print file name
If (InStr(objFile.path, ".CATPart")) Then
list.Add (objFile.name)
' Set objDocument = CATIA.Documents.Open(objFile.path)
Dim srcDoc As PartDocument
Set srcDoc = CATIA.Documents.Open(objFile.path)
Dim srcPart As Part
Set srcPart = srcDoc.Part
Dim oSel As Selection
Dim bodies1 As Bodies
Dim body1 As body
'
Set bodies1 = srcPart.Bodies
For Each single_body In srcPart.Bodies
A = exportStl(single_body)
Next
Set body1 = srcPart.Bodies.Item(i)
'Dim BoxProduct
'BoxProduct = MsgBox("Quantity of the bodies found:" & srcDoc.Part.Bodies.Count & "", 64)
End If
Next
End Sub
Public Function exportStl(ByVal myBody As body)
Dim oSrc As Part
Dim oTgt As Part
Dim oSrcDoc As PartDocument
Dim oTgtDoc As PartDocument
Dim oBod As body
Dim oSel As Selection
'Sets documents for Source and Target files
Set oSrcDoc = CATIA.ActiveDocument
Set oTgtDoc = CATIA.Documents.Add("Part")
oTgtDoc.Product.PartNumber = myBody.name
'Gets Body to copy
Set oSrc = oSrcDoc.Part
Set oTgt = oTgtDoc.Part
Set oBod = myBody
Set oSel = oSrcDoc.Selection
'Copies Body
oSel.Add oBod
oSel.Copy
Set oSel = oTgtDoc.Selection
'Sets and Pastes in Target file as result with link
oSel.Clear
oSel.Add oTgt.Bodies.Item(1)
oSel.Paste
oSrcDoc.Selection.Clear
CATIA.ActiveDocument.ExportData input_path + myBody.name, "stl"
CATIA.ActiveDocument.Close
End Function
Catia V5 is capable of creating STL files from parts (CatiaPART files), but not from assemblies (CatiaPRODUCT files) or geometrical representations (car files). Therefore, source files, including those saved in a neutral format (STEP or IGES, for example), must be saved as parts. If the source design was saved as an assembly, it is imported to Catia as a product. -
Source : http://www.stratasys.com/customer-support/cad-to-stl/catia
I tried exporting CATBody but was unsuccessful. We must have a CATPart to generate STL

Read item titles from SharePoint Document Library into Array using Excel VBA

I need to read all the item titles for all the documents in a SharePoint document library directly into an Array using Excel VBA. I can't seem to successfully use FileSystemObject and I do not want to map the document library to a drive letter as the macro will be distributed and widely used.
The SharePoint site has an https address
I have looked at this thread about referencing scrrun.dll but it does not work because I cannot change the trust settings on my local domain
This thread looked promising, but again it seems to use FileSystemObject which might be my hang up.
This thread on the SharePoint stackexchange site works well for reading in a list of files as a worksheet object, but I don't know how it could be adapted to be pushed directly into an array.
I tend to receive Error 76 "Bad Path", but I am easily able to execute on local (C:) files.
I have tried using a WebDAV address - like the answer I gave to this thread - but it too encounters a "Bad Path" error.
There must be a way to read in the contents of a SharePoint document library directly into an array that does not violate my local security policies and doesn't depend upon an excel worksheet.
Ok I am going to self answer. I'm not 100% thrilled with my solution, but it does suffice within my constraints. Here are the high level points:
Use VBA to create BAT files that have the "Net Use" command within them.
Reference the WebDAV address of the document library and find an available drive letter
I doubt that any of my users already have 26 mapped drives...).
Once the document library is mapped it can be iterated through using FileSystemObject commands and the item titles can be loaded into a two dimensional array.
The code will have to be modified to allow for 3 the listing of subfolders
The location of the file count in the ListMyFiles sub would have to be changed or another dimension would have to be added to the array.
Here is the code - I will try to credit all Stack solutions that were integrated into this answer:
Private Sub List_Files()
Const MY_FILENAME = "C:\BAT.BAT"
Const MY_FILENAME2 = "C:\DELETE.BAT"
Dim i As Integer
Dim FileNumber As Integer
Dim FileNumber2 As Integer
Dim retVal As Variant
Dim DriveLetter As String
Dim TitleArray()
FileNumber = FreeFile
'create batch file
For i = Asc("Z") To Asc("A") Step -1
DriveLetter = Chr(i)
If Not oFSO.DriveExists(DriveLetter) Then
Open MY_FILENAME For Output As #FileNumber
'Use CHR(34) to add escape quotes to the command prompt line
Print #FileNumber, "net use " & DriveLetter & ": " & Chr(34) & "\\sharepoint.site.com#SSL\DavWWWRoot\cybertron\HR\test\the_lab\Shared Documents" & Chr(34) & " > H:\Log.txt"
Close #FileNumber
Exit For
End If
Next i
'run batch file
retVal = Shell(MY_FILENAME, vbNormalFocus)
' NOTE THE BATCH FILE WILL RUN, BUT THE CODE WILL CONTINUE TO RUN.
'This area can be used to evaluate return values from the bat file
If retVal = 0 Then
MsgBox "An Error Occured"
Close #FileNumber
End
End If
'This calls a function that will return the array of item titles and other metadata
ListMyFiles DriveLetter & ":\", False, TitleArray()
'Create code here to work with the data contained in TitleArray()
'Now remove the network drive and delete the bat files
FileNumber2 = FreeFile
Open MY_FILENAME2 For Output As #FileNumber2
Print #FileNumber2, "net use " & DriveLetter & ": /delete > H:\Log2.txt"
Close #FileNumber2
retVal = Shell(MY_FILENAME2, vbNormalFocus)
'Delete batch file
Kill MY_FILENAME
Kill MY_FILENAME2
End Sub
Here is the function that will read through the directory and return the array of file information:
Sub ListMyFiles(mySourcePath As String, IncludeSubFolders As Boolean, TitleArray())
Dim MyObject As Object
Dim mySource As Object
Dim myFile As File
Dim mySubFolder As folder
Dim FileCount As Integer
Dim CurrentFile As Integer
'Dim TitleArray()
Dim PropertyCount As Integer
CurrentFile = 0
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(mySourcePath)
FileCount = mySource.Files.Count
ReDim TitleArray(0 To FileCount - 1, 4)
'On Error Resume Next
For Each myFile In mySource.Files
PropertyCount = 1
TitleArray(CurrentFile, PropertyCount) = myFile.Path
PropertyCount = PropertyCount + 1
TitleArray(CurrentFile, PropertyCount) = myFile.Name
PropertyCount = PropertyCount + 1
TitleArray(CurrentFile, PropertyCount) = myFile.Size
PropertyCount = PropertyCount + 1
TitleArray(CurrentFile, PropertyCount) = myFile.DateLastModified
CurrentFile = CurrentFile + 1
Next
'The current status of this code does not support subfolders.
'An additional dimension or a different counting method would have to be used
If IncludeSubFolders = True Then
For Each mySubFolder In mySource.SubFolders
Call ListMyFiles(mySubFolder.Path, True, TitleArray())
Next
End If
End Sub
Thank you to Chris Hayes for his answer to find empty network drives; thank you to Kenneth Hobson on ozgrid for his expanded answer on listing files in a directory. The rest of the code is ancient and I dredged it out of a folder I last touched in 2010.

Path not found error when trying to access sharepoint

I am using this code to loop through the files in sharepoint using excel VBA. This code is working fine when I am using the local drive path. But when I replace the path with my sharepoint path, I am getting an error saying 'Path Not Found' at fs.GetFolder
Please kindly advice
Code I am using is:
Private Sub CommandButton2_Click()
Dim folder As Variant
Dim f As File
Dim fs As New FileSystemObject
Dim fs1 As New OLEObject
Dim RowCtr As Integer
Dim FPath As String
Dim wb As Workbook
FPath = "my URL"
Set fs = CreateObject("Scripting.FileSystemObject")
RowCtr = 1
Set folder = fs.GetFolder(FPath)
'<=Variable Location
For Each f In folder.Files
Cells(RowCtr, 1).Value = f.Name
RowCtr = RowCtr + 1
Next f
End Sub
You'll need to map sharepoint to a Windows drive letter, as outlined in SharePoint StackExchange. Once it's mapped you'll be able to open as a local drive path.

Permission Denied when running VBScript

I have a vbs script which captures file information and then exports it to a csv file. I need to run the script on main drives such as C:\, E:\, I:\ and more, but each time I run for the main directory I get "Permission Denied" when I try to run it for a subfolder example C:\Program Files it works fine. I have tested this on different desktop machines and servers with full admin accounts and still get it.
What could be the issue with this code. test.vbs
Option Explicit
Dim objFS, objFld
Dim objArgs
Dim strFolder, strDestFile, blnRecursiveSearch
Dim strLines()
Dim i
Dim strCsv
i = 0
' 'Get the commandline parameters
' Set objArgs = WScript.Arguments
' strFolder = objArgs(0)
' strDestFile = objArgs(1)
' blnRecursiveSearch = objArgs(2)
'###################################
'MAKE SURE THESE VALUES ARE CORRECT
'###################################
strFolder = "C:\"
strDestFile = "C:\Output.csv"
blnRecursiveSearch = True
'Create the FileSystemObject
Set objFS=CreateObject("Scripting.FileSystemObject")
'Get the directory you are working in
Set objFld = objFS.GetFolder(strFolder)
'Now get the file details
GetFileDetails objFld, blnRecursiveSearch
'Write the csv file
Set strCsv = objFS.CreateTextFile(strDestFile, True)
strCsv.Write Join(strLines, vbCrLf)
'Close and cleanup objects
strCsv.Close
Set strCsv = Nothing
Set objFld = Nothing
Set strFolder = Nothing
Set objArgs = Nothing
Private Sub GetFileDetails(fold, blnRecursive)
Dim fld, fil
dim strLine(5)
If blnRecursive Then
'Work through all the folders and subfolders
For Each fld In fold.SubFolders
GetFileDetails fld, True
Next
End If
'Now work on the files
For Each fil in fold.Files
strLine(0) = fil.Path
strLine(1) = fil.Type
strLine(2) = fil.Size
strLine(3) = fil.DateCreated
strLine(4) = fil.DateLastModified
strLine(5) = fil.DateLastAccessed
Redim Preserve strLines(i)
strLines(i) = Join(strLine, ",")
i = i + 1
Next
end sub
Please advise and modify code if you know where the issue is.
If it's a permissions problem I would strongly recommend Process Monitor from Sysinternals to diagnose it. You should be able to watch the cscript process (or whatever is executing your script) and find out what kind of permission problem you're having.