I have this code to upload a document to SharePoint via VBA by mapping it to a drive.
I get
"Compile error, Sub or function not defined".
Then it highlights the second quote mark from this line:
objNet.MapNetworkDrive “A: ” , SharepointAddress
Below is the entire subroutine.
Sub UploadToSharepoint()
Dim SharepointAddress As String
Dim LocalAddress As String
Dim objNet As Object
Dim FS As Object
SharepointAddress = "http://share.deere.com/teams/sm_at_sd/suppcaptracking/Test"
LocalAddress = ”c: MyWorkFiletoCopy.xlsx”
Set objNet = CreateObject(“WScript.Network”)
Set FS = CreateObject(“Scripting.FileSystemObject”)
objNet.MapNetworkDrive “A: ” , SharepointAddress
If FS.FileExists(LocalAddress) Then
FS.CopyFile LocalAddress, SharepointAddress
End If
objNet.RemoveNetworkDrive “A: ”
Set objNet = Nothing
Set FS = Nothing
End Sub
I had a similar challenge. Exporting the file was not working. Correcting errors in code formatting and spacing, I created a subroutine that will do this. It is working well on my machine.
This sub takes four arguments: the name of the file, path to where the file is now, the path to the sharepoint folder, and an optional argument for the temporary mapped network drive (in case A is used on a machine).
Public Sub uploadFileToSP(filename As String, localPath As String, sharePath As String, Optional tempdrive As String = "A:")
Dim ObjNet As Object, FS As Object
Set ObjNet = CreateObject("WScript.Network")
Set FS = CreateObject("Scripting.FileSystemObject")
If FS.FileExists(localPath & Application.PathSeparator & filename) Then
ObjNet.MapNetworkDrive tempdrive, sharePath
FS.CopyFile localPath & Application.PathSeparator & filename, tempdrive & Application.PathSeparator & filename
ObjNet.RemoveNetworkDrive tempdrive
Set ObjNet = Nothing
End If
End Sub
Here is an example call to the subroutine
Call uploadFileToSP("myImage.JPG", "D://my/path", "https://my/sharepoint/path", "A:")
Your Quotation marks look a little strange in the area in question : ”.
Delete ” and replace them with the ones " that you have used for the shapepointaddress =... variable.
I would expect:
SharepointAddress = "\\share.deere.com\teams\sm_at_sd\suppcaptracking\Test"
Related
I have a piece of code that checks if an excel file opened or not by someone and display that user's username if it is opened. It was working fine, but recently it is throwing some error as shown in picture. But the error occurs only sometimes and not always. Anyone knows why?
Sub TestFileOpened()
Dim Folder As String
Dim FName As String
Dim fileOpenedOrNot As String
fileOpenedOrNot = "\\122.00.00.000\shared\Admin Confidential\Admin_Planner Database\Admin\Templates and Files\~$Running Numbers and ComboBox Lists.xlsx"
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 seconds and try 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
The following is the line that throwing error
objWMIService.Get("Win32_LogicalFileSecuritySetting='" & strFileName & "'")
Update 1
After further checks, I noticed there were no temp file ~$Running Numbers and ComboBox Lists.xlsx created although that file is opened. Basically objFSO.FileExists(fileOpenedOrNot) setting to true and going into that if condition. But when it calls the GetFileOwner function, it is not seeing the file and probably that is why have the error.
Like I mentioned, this code was working earlier without issues, but all of a sudden having such problem. Anyone knows why there is no such temp file created?
Check if this method works for you. Looks like it works for me better than yours but still it throws me Predefined\Administrators as owner on the network instead of the correct user name.
Option Explicit
Public Sub test()
Const fileOpenedOrNot As String = "\\122.00.00.000\shared\Admin Confidential\Admin_Planner Database\Admin\Templates and Files\~$Running Numbers and ComboBox Lists.xlsx"
Dim objFSO As FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FileExists(fileOpenedOrNot) Then
Dim objFile As Object
Set objFile = objFSO.GetFile(fileOpenedOrNot)
MsgBox GetFileOwner(objFile.ParentFolder & "\", objFile.Name)
End If
End Sub
Public Function GetFileOwner(ByVal fileDir As String, ByVal fileName As String) As String
Dim securityUtility As Object
Set securityUtility = CreateObject("ADsSecurityUtility")
Dim securityDescriptor As Object
Set securityDescriptor = securityUtility.GetSecurityDescriptor(fileDir & fileName, 1, 1)
GetFileOwner = securityDescriptor.Owner
End Function
So, I read a lot of topics and similar questions, but could not understand properly.
I am running the code below, both the destinfilename and SourceFileName are correct, I checked with Debug.Print.
Debug gave me these results:
SourceFileName = "C:\Users\Renan\Desktop\BulkPdf\Documentos gerados\Doc.1-aaaaa.pdf"
namefile2 = "Doc.1-aaaaa.pdf"
destinfilename = "C:\Users\Renan\Desktop\BulkPdf\Documentos gerados\Doc.1-aaaaa"
When I copy the directory, and the destinfilename and copy on IE, work just perfect, but when running the code, always got "Error 53 File Not Found"
I tried putting and removing "", nothing worked.
NOTE 1: I want to move the file Doc.1-aaaaa.pdf to a folder with the same name, so the folder name is Doc.1-aaaaa
NOTE 2: I've been asking a lot of questions, I know and apologize, but I don't have a background on programming - I'm a lawyer - but I'm trying to learn something new by myself (without classes, just YouTube and forum) and VBA is really fun and useful.
I'm using this code. The problem is in the code?
Sub creating_pdfs()
Call LoopThroughFilesInFolder("C:\Users\Renan\Desktop\BulkPdf\Documentos gerados\", "Doc*")
End Sub
Sub LoopThroughFilesInFolder(strDir As String, Optional strType As String)
Dim FSO As Object
Dim SourceFileName As String, destinfilename As String
Dim namefile1 As String
Dim dot
Dim namefile2 As String
Dim file As Variant
If Right(strDir, 1) <> "\" Then strDir = strDir & "\"
file = Dir(strDir & strType)
While (file <> "")
Debug.Print file
SourceFileName = "C:\Users\Renan\Desktop\BulkPdf\Documentos gerados\" & file
namefile1 = file
dot = InStr(namefile1, "pdf") - 2
namefile2 = Left(namefile1, dot)
destinfilename = "C:\Users\Renan\Desktop\BulkPdf\Documentos gerados" & "\" & namefile2
Debug.Print namefile2
Debug.Print SourceFileName
Debug.Print destinfilename
Set FSO = CreateObject("scripting.FileSystemObject")
FSO.MoveFile Source = SourceFileName, Destination:=destinfilename
file = Dir
Wend
End Sub
That code would not work the way it is because you have an evaluation in the source of your move. The evaluation of Source = SourceFileName is False. So you are trying to move a file named False, which doesn't exist.
Change this:
FSO.MoveFile Source = SourceFileName, Destination:=destinfilename
To this:
FSO.MoveFile SourceFileName, destinfilename
Other notes:
Call is deprecated, just remove it
while...wend is deprecated, use do while...loop or do...loop while instead.
Properly indent\space\format your code so it's easier to read.
Use FSO.GetFolder pattern instead of Dir
Use Option Explicit to avoid situations where an unintended new variable is created. In this case Source is a new variable that you didn't know you were using.
I have most of the codes but cannot run it. Some basic info is that my username is nywongab, I want it as a text file and the text file placed on the desktop.
Thanks
Sub createsth()
Dim abbyFilesystem As filesystemobject
Dim abbyfile As File
Set abbyFilesystem = CreateObject("scripting.filesystemobject")
Set abbyfile =_
abbyFilesystem.createtextfile("C:\Users\nywongab\Desktop"_
& ".txt")_
Dim result As String
result = "A"
abbyfile.write (result)
End Sub
Not quite clear the question.. though from the subject you have a problem with writing to file. From the code is obviously not working, but you were close.
If you are trying to get the username or the desktop path more dynamically, you can use Environ like so:
Sub createsth()
Dim pathDesktop As String
pathDesktop = Environ("USERPROFILE") & "\Desktop\"
Dim pathSave As String
pathSave = pathDesktop & Environ("USERNAME") & ".txt"
Dim abbyFileSystem As Object
Set abbyFileSystem = CreateObject("Scripting.FileSystemObject")
Dim abbyFile As Object
Set abbyFile = abbyFileSystem.CreateTextFile(pathSave)
Dim result As String
result = "A"
abbyFile.Write result
abbyFile.Close
End Sub
So I posted a question here:
VBA - Find Specific Sub Folders by Name Identifiers
This question was very broad, but I was facing specific issues I needed help identifying and resolving. Now, I managed to resolve those issues in the original post, however, there is still a good portion of the question unanswered and I would like to close the question only when I am able to post the full result.
Currently, what I still need to do, it the last 4 steps:
Open ZipFile
Look for .png extenstion
Grab the name of the .png file
Put the name in a cell in excel
The issue I am facing, is that of properly opening the zip file. I been through so many posts on this but NOTHING seems to work for me.
The closest I have come to accomplishing the task is what I found here:
https://www.ozgrid.com/forum/forum/help-forums/excel-general/109333-how-to-count-number-of-items-in-zip-file-with-vba-2007
I figure, if at the very least, I am able to enter the zip file, I can then work from there. But alas, I am still stuck at simply trying to open the file.
Here is the code I have (Using from the link above):
Sub CountZipContents()
Dim zCount As Double, CountContents As Double
Dim sh As Object, fld As Object, n As Object
Dim FSO As Object
CountContents = 0
zCount = 0
x = "C:\Users\UserName\Desktop\Today\MyFolder\"
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(x) Then
For Each FileInFolder In FSO.GetFolder(x).Files
If Right(FileInFolder.Name, 4) = ".png" Then
CountContents = CountContents + 1
ElseIf Right(FileInFolder.Name, 4) = ".Zip" Then
Set sh = CreateObject("Shell.Application")
Set ZipFile = sh.Namespace(CVar(x & "\" & FileInFolder.Name))
Debug.Print FileInFolder.Name
For Each fileInZip In ZipFile.Items
If LCase(fileInZip) Like LCase("*.png") Then
CountContents = CountContents + 1
End If
Next
End If
Next FileInFolder
End If
Set sh = Nothing
End Sub
The issue I get is on this line:
For Each fileInZip In ZipFile.Items
Error Message:
Object variable or With block not set
Whenever I tried to use Shell, like below:
Dim oShell As New Shell
I get this error:
User-defined type not defined
With the below:
Link https://msdn.microsoft.com/en-us/library/windows/desktop/bb776890(v=vs.85).aspx
Dim oApp As Object
Set oApp = CreateObject("WScript.Shell")
'get a shell object
Set oApp = CreateObject("Shell.Application")
If oApp.Namespace(ZipFile).Items.count > 0 Then
I get this error:
Object doesn't support this property or method
On this line:
If oApp.Namespace(ZipFile).Items.count > 0 Then
References to links I have tried:
https://wellsr.com/vba/2015/tutorials/open-and-close-file-with-VBA-Shell/
http://www.vbaexpress.com/forum/showthread.php?38616-quot-shell-quot-not-work-in-Excel
Excel VBA - read .txt from .zip files
I just don't understand why this step is taking so much time to complete.
Your main problem is a really simple one: Your path "C:\Users\UserName\Desktop\Today\MyFolder\" contains already a trailing backslash, and when you set your ZipFile-variable, you are adding another one between path and filename. This will cause the shell-command to fail and ZipFile is nothing.
There are some minor problems with the code. I would recommend to use the GetExtensionName of your FileSystemObject to get the extension and convert this to lowercase so that you catch all files, no matter if they are .PNG, .png or .Png
For Each FileInFolder In FSO.GetFolder(x).Files
Dim fileExt As String
fileExt = LCase(FSO.GetExtensionName(FileInFolder.Name))
If fileExt = "png" Then
CountContents = CountContents + 1
Debug.Print "unzipped " & FileInFolder.Name
ElseIf fileExt = "zip" Then
Dim ZipFileName As String, ZipFile, fileInZip
Set sh = CreateObject("Shell.Application")
ZipFileName = x & FileInFolder.Name
Set ZipFile = sh.Namespace(CVar(ZipFileName))
For Each fileInZip In ZipFile.Items
If LCase(FSO.GetExtensionName(fileInZip)) = "png" Then
CountContents = CountContents + 1
Debug.Print "zipped in " & FileInFolder.Name & ": " & fileInZip
End If
Next
End If
Next FileInFolder
Additionally the strong advice to use Option Explicit and define all your variables. And split commands into smaller pieces. This costs you only a few seconds of typing the extra lines but helps you when debugging your code:
' Instead of
' Set ZipFile = sh.Namespace(CVar(x & "\" & FileInFolder.Name))
' write
Dim fName as string
fName = x & "\" & FileInFolder.Name; ' Now you can check fName and see the problem.
Set ZipFile = sh.Namespace(CVar(fName))
Try this:
Option Explicit
' Just to test CheckZipFolder
Sub TestZip()
Dim sZipFold As String: sZipFold = "C:\Temp\MyZip.zip" ' Change this to the path to your zip file
CheckZipFolder sZipFold
End Sub
Sub CheckZipFolder(ByVal sZipFold As String)
Dim oSh As New Shell ' For this, you need to add reference to 'Microsoft Shell Controls and Automation'
Dim oFi As Object
' Loop through all files in the folder
For Each oFi In oSh.Namespace(sZipFold).Items
' Checking for file type (excel file in this case)
If oFi.Type = "Microsoft Excel Worksheet" Then
MsgBox oFi.Name
'..... Add your actions here
End If
' This will make the UDF recursive. Remove this code if not needed
If oFi.IsFolder Then
CheckZipFolder oFi.Path
End If
Next
' Clear object
Set oSh = Nothing
End Sub
I need a solution to add a VBA script to a rule in Outlook that searches for the word before the phrase "was" in the email subject line, then save the attachment (excel file) using that word in a designated folder.
I'm familiar with the InStr() method, but for whatever reason, I can't figure out how to work it in with the current code. Anyone have any ideas?
This is the current working script I have before adding this new line:
Public Sub saveAttachtoDisk(itm As Outlook.MailItem)
Dim objAtt As Outlook.Attachment
Dim saveFolder As String
Dim saveFolder2 As String
Dim attname As String
Dim fso As FileSystemObject
Dim stream As TextStream
saveFolder = "C:\Users\testuser\Desktop\Files\Reports"
saveFolder2 = "\\SERVER\C\Users\Service\Documents"
For Each objAtt In itm.Attachments
objAtt.SaveAsFile saveFolder & "\" & objAtt.DisplayName
attname = objAtt.DisplayName
Call updatelog(attname)
objAtt.SaveAsFile saveFolder2 & "\" & objAtt.DisplayName
Call updatelog(attname)
Set objAtt = Nothing
Next
Thanks
Here's a generic function that will return the word preceding a trigger word.
Function WordBeforeTrigger(sInput As String, sTrigger As String) As String
Dim vaSplit As Variant
Dim i As Long
Dim sReturn As String
vaSplit = Split(sInput, Space(1))
For i = LBound(vaSplit) + 1 To UBound(vaSplit)
If vaSplit(i) = sTrigger Then
sReturn = vaSplit(i - 1)
Exit For
End If
Next i
WordBeforeTrigger = sReturn
End Function
This is how to use it in the Immediate Window
?wordbeforetrigger("Report1 2012 was run on 7/11/2013 at 11:58:35pm","was")
2012
?wordbeforetrigger("I was home","was")
I
?wordbeforetrigger("","was")
?wordbeforetrigger("doesn't contain","was")
Those blank lines are empty strings. You need to code to account for when the word isn't found and an empty string is returned. You could modify the function to return sInput if Len(sReturn)=0 or something like that.
It appears you want to pass in DisplayName and "was" and it will return the value. You can store that in a string variable and use it as your attachment name.
There's nothing wrong with using Instr, but you'll notice I didn't. I prefer to use Split and navigate the resulting array rather than Instr.