I have a VBScript for zipping up old IIS log files. I keep getting this error though:
Microsoft VBScript runtime error: ActiveX component can't create
object: 'GetObject'
This is the line it errors on:
Set objIISOuter = GetObject("IIS://LOCALHOST")
I am unsure of what this means.
Tried what I found here and I wasn't able to get anything running with 32 or 64 bit.
I read somewhere that it could be a problem with a DLL not being registered but I don't know how this could be an issue here, might be wrong though.
For Each objWebOuter in objIISOuter
If LCase(objWebOuter.Class) = "iiswebservice" Then
Set objIIS = GetObject("IIS://LOCALHOST/W3SVC")
For Each objWeb in objIIS
If LCase(objWeb.Class) = "iiswebserver" Then
Call DeleteLogFiles( _
objWeb.LogFileDirectory & "\W3SVC" & objWeb.Name, _
intZipAge, intDelAge)
End If
I'm an admin so permissions aren't the issue. Any ideas?
Here are two potential approaches:
Use the FileSystemObject to get the LogFiles folder and delete files:
sLogFolder = "%SystemDrive%\inetpub\logs\LogFiles"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(sLogFolder)
For Each objSubfolder In objFolder.SubFolders
DeleteFiles objSubfolder.Path, 10
Next
Another approach:
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objIIS = GetObject("winmgmts:root\WebAdministration")
Set objSites = objIIS.InstancesOf("Site")
For Each objSite In objSites
DeleteFiles objSite.LogFile.Directory & "\w3svc\" & objSite.ID, 10
Next
Both approaches use the following Sub to delete the files from a folder:
Sub DeleteFiles(p_sFolder, p_iMaxAge)
Dim objFSO
Dim objFolder
Dim objFile
Dim iFileAge
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(p_sFolder)
If objFolder Is Nothing Then Exit Sub
For Each objFile In objFolder.Files
iFileAge = Now - objFile.DateCreated
If iFileAge > (p_iMaxAge) Then
objFSO.DeleteFile objFile, True
End If
Next
End Sub
Related
I have the following script. Want the number of folder, subfolders and files:
Sub CountFiles(ByVal path1 As String)
Dim fso As Object
Dim subfolder As Object
Dim file As Object
Dim folder As Object
Dim stetje As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(path1)
For Each subfolder In folder.SubFolders
CountFiles (subfolder.path)
Next subfolder
For Each file In folder.Files
Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = file.path
Next file
Set fso = Nothing
Set folder = Nothing
Set subfolder = Nothing
Set file = Nothing
End Sub
Which you call as:
Sub someStuff()
Call CountFiles ("c:/temp/test/")
End Sub
This script writes into Excel cells paths to all the folders, subfolders and files
But what I really want is to count the TOTAL of all the the occurrences into a variable.
So instead of this:
For Each file In folder.Files
Range("A" & Rows.Count).End(xlUp).Offset(1, 0) = file.path
Next file
I would like something like this:
For Each file In folder.Files
number = number + file.path.Count // of course this line is completely pseudo
Next file
So the wanted output is for example the number: 2345 and not 2345 rows with paths written out.
Any help / hints would be appreciated!
Here's a way to do it:
Function CountFiles(ByVal path As String) As Long
Dim fso As Object
Dim folder As Object
Dim subfolder As Object
Dim amount As Long
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(path)
For Each subfolder In folder.SubFolders
amount = amount + CountFiles(subfolder.path)
Next subfolder
amount = amount + folder.Files.Count
Set fso = Nothing
Set folder = Nothing
Set subfolder = Nothing
CountFiles = amount
End Function
Sub someStuff()
MsgBox CountFiles("c:/temp/test/")
End Sub
I've turned the sub into a function, which returns the amount of files found in that folder and the subfolders. As before, this works recursively.
A non-recursive option:
Function FilesCount(fldr As String)
Dim colFolders As New Collection, fso, num As Long, f As Object, sf As Object
Set fso = CreateObject("Scripting.FileSystemObject")
colFolders.Add fso.getfolder(fldr) 'add the starting folder
num = 0
Do While colFolders.Count > 0 'while we still have folders to process...
Set f = colFolders(1) ' get the first folder from the collection
colFolders.Remove 1 ' and remove it from the collection
num = num + f.Files.Count ' Add # of files in that folder
For Each sf In f.subfolders ' and add each subfolder into the collection
colFolders.Add sf
Next sf
Loop
FilesCount = num
End Function
I am trying to correct this code:
Dim ab2 As String
ab2 = Worksheets("Sheet1").Range("b2").Value
Dim ObjFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Set ObjFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = ObjFSO.GetFolder(ab2)
Call getfiledetails(objFolder)
End Sub
My Target is to assign the value of cell b2 (which is a folder location) to my
objFolder.ObjFSO.GetFolder(ab2)
But I am having the "Path Not Found" Error.
I also used objFolder.ObjFSO.GetFolder&ab2 but I get a different error message.
Any idea on how to correct this?
Thanks!
I'm writing a script where I wish to write an HTML doc to a string from sharepoint.
Dim Content As String
Dim strShare As String: strShare = "\\link\to\share.html"
Dim iFile As Integer: iFile = FreeFile
Open strShare For Input As #iFile
Content = Input(LOF(iFile), iFile)
Close #iFile
However, I find I get a "path/file access error" every time I run the script for the first time upon boot. Once I visit "\link\to\share.html" in IE for the first time, the path begins to resolve in the VBA script.
My only thought is that IE is performing some sort of "DNS Cache" that VBA can't do. Currently my workaround is to catch the error and force the URL to open in IE the first time the script is run. After that, every other HTML file under that share loads fine.
As a test, I tried switching between from what I understand is http:// formatting (forward slash) and WebDAV formatting (\\ formating), and only the backslash separated paths ever work. I also tried to resolve the share to an IP and try it that way, but that never worked.
My last thought is to try mapping the share to a drive letter name and then specifically accessing the share with G:\link\to\mapped\share.html. But I don't see this as an elegant solution, and wonder if it will receive the same error any way.
Is there something blatant that I do not understand about WebDAV, Windows file handling, and VBA file inputs? There's something weird going on under the hood with resolving that shared domain, and I can't seem to debug it.
See if this helps here and an example below that I used.
2 things though: I only worked with Excel files on Sharepoint and I was already logged in there.
Dim oFSO As Object
'Dim oFolder As Object 'if needed
'Dim oFile As Object 'if needed
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder("\\sharepoint.site.com#SSL\DavWWWRoot\sites\")
'For Each oFolder In oFolder.SubFolders 'loops through folders
' For Each oFile In oFolder.Files 'loops through files
' 'do stuff
' Next oFile
'Next oFolder
I'm a bit confused about what you want to do. Do you want to check out files from SP and check files back into SP?
Sub testing()
Dim docCheckOut As String
'docCheckOut = "//office.bt.com/sites/Training/Design Admin/Training Plan/adamsmacro.xlsm"
docCheckOut = "http://your_path_here/ExcelList.xlsb"
Call UseCheckOut(docCheckOut)
End Sub
Sub UseCheckOut(docCheckOut As String)
' Determine if workbook can be checked out.
If Workbooks.CanCheckOut(docCheckOut) = True Then
Workbooks.CheckOut docCheckOut
Else
MsgBox "Unable to check out this document at this time."
End If
End Sub
Or...do you want to list files in a SP folder?
Sub ListFiles()
Dim folder As Variant
Dim f As File
Dim fs As New FileSystemObject
Dim RowCtr As Integer
Dim FPath As String
Dim wb As Workbook
RowCtr = 1
FPath = "http://excel-pc:43231/Shared Documents"
For Each f In FPath
'Set folder = fs.GetFolder("C:\Users\Excel\Desktop\Ryan_Folder")
'For Each f In folder.Files
Cells(RowCtr, 1).Value = f.Name
RowCtr = RowCtr + 1
Next f
End Sub
Sub test()
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("C:\Users\Excel\Desktop\Ryan_Folder")
'Set colSubfolders = objFolder.SubFolders
'For Each objSubfolder In colSubfolders
Cells(RowCtr, 1).Value = f.Name
RowCtr = RowCtr + 1
'Next
End Sub
I have the following code
Sub Kenneth_Li()
Dim objOL As Outlook.Application
Dim Msg As Outlook.MailItem
Set objOL = CreateObject("Outlook.Application")
inPath = "C:\Users\SiliconPlus\Desktop\Si+ Contact Lists\Contact_Si+"
thisFile = Dir(inPath & "\*.msg")
Do While thisFile <> ""
'Set Msg = objOL.CreateItemFromTemplate(thisFile)
'Or
Set Msg = objOL.OpenSharedItem(thisFile)
Msg.display
MsgBox Msg.Subject
thisFile = Dir
Loop
Set objOL = Nothing
Set Msg = Nothing
End Sub
When I use OpenSharedItem it gives a run-time error 438 Object doesn't support this property or method.
When I use CreateItemFromTemplate I get the following error:
Cannot open file: AUTO Andy Low Yong Cheng is out of the office (returning 22 09 2014).msg.
The file may not exist, you may not have permission to open it, or it may be open in another program.
Right-click the folder that contains the file, and then click properties to check your permissions for the folder.
I'm not 100% on what you're trying to get at with the code, but try this:
Sub LiminalMsgbx()
Dim outappp, outmaill As Object
Dim pthh As String
pthh = "C:\DeskTop\MyTemplate.oft"
Set outappp = CreateObject ("Outlook.Application")
Set outmaill = outapp.CreateItemFromTemplate(pthh)
With outmaill
.display
End With
Set outappp = Nothing
Set outmaill = Nothing
End Sub
You can also use .send instead of .display.
OpenSharedItem method is exposed by the Namespace object, not Application.
Set objOL = CreateObject("Outlook.Application")
set objNs = objOL.GetNamespace("MAPI")
objNs.Logon
...
Set Msg = objNs .OpenSharedItem(thisFile)
As for the second error, it is pretty unambiguous - the file cannot be found. You must provider a fully qualified file name with the folder path. You are only providing the file name.
I searched SO, SU, and SP.SE for a solution, but could not find what I needed. I'm looking for a solution which may be a script or some other non-coding method/tool.
I am trying to write a script (to be used by others) or some other form of automation to upload various reports automatically to a SharePoint site. I have managed to get the following (VBScript) code to work, but only for text-based files -- .CSV in this case, though this also works for .TXT, etc.
Option Explicit
Dim sCurPath
sCurPath = CreateObject("Scripting.FileSystemObject").GetAbsolutePathName(".")
UploadAllToSP sCurPath
Sub UploadAllToSP(sFolder)
Dim fso, folder, fil
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(sFolder)
For Each fil In folder.Files
If fso.GetExtensionName(fil) = "csv" Then
UploadFileToSP fil
End If
Next
End Sub
Sub UploadFileToSP(ofile)
Dim xmlhttp
Dim sharepointUrl
Dim sharepointFileName
Dim tsIn
Dim sBody
Set tsIn = ofile.openAsTextstream
sBody = tsIn.readAll
tsIn.close
sharepointUrl = "http://SHAREPOINT URL HERE"
sharepointFileName = sharepointUrl & ofile.name
set xmlHttp = createobject("MSXML2.XMLHTTP.4.0")
xmlhttp.open "PUT", sharepointFileName, false
xmlhttp.send sBody
If xmlhttp.status < 200 Or xmlhttp.status > 201 Then
wscript.echo "There was a problem uploading " & ofile.name & "!"
End If
End Sub
This only works for text files because it pipes the text data into a file on the SP site. However, if I want to transfer any kind of binary file (.XLS, .PDF), this results in garbage being uploaded.
I tried to take a look at a Shell.Application ==> .Namespace(), but this doesn't seem to work with a URL, but only a physical drive. Here's some of what else I tried (trimmed to show relevant pieces):
Set oApp = CreateObject("Shell.Application")
If oApp.NameSpace(sharepointUrl) <> Null then ' Always Null!
' Copy here
' Some lines omitted
oApp.NameSpace(sharepointUrl).CopyHere ofile.Name ' This also fails when not surrounded by the Null check
Else
MsgBox "SharePoint directory not found!"
End If
I also tried a batch file using xcopy, but that can't connect to the http:// either. I looked at this method, which may work for me, but I'd prefer not to deal with mapping/NET USE, since our company has multiple network shares, the mapping for which varies depending on who's logged in.
Since none of these work quite the way I need: Is there a method to automate this kind of functionality?
I have experience with VBA/VBscript, so either a script like the above, or something built in to an MS Office application (Outlook is best, but I can probably adapt whatever I am given) would be preferable. That being said, I am open to any method that would allow me to do this, running natively in Windows or Office. However, I do not have access to Visual Studio, so I can't use any .NET functionality.
Thanks to Sean Cheshire for pointing me at the obvious answer that I did not see. Posting the relevant code, since I don't believe this yet exists on SO.
Sub UploadFilesToSP(sFolder)
Dim sharepointUrl
Dim sharepointFileName
Dim LlFileLength
Dim Lvarbin()
Dim LobjXML
Dim LvarBinData
Dim PstrFullfileName
Dim PstrTargetURL
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
Dim fldr
Dim f
'This has not been successfully tested using an "https" connection.
sharepointUrl = "http://SHAREPOINT URL HERE"
Set LobjXML = CreateObject("Microsoft.XMLHTTP")
Set fldr = fso.GetFolder(sFolder)
For Each f In fldr.Files
sharepointFileName = sharepointUrl & f.Name
PstrFullfileName = sFolder & f.Name
LlFileLength = FileLen(PstrFullfileName) - 1
' Read the file into a byte array.
ReDim Lvarbin(LlFileLength)
Open PstrFullfileName For Binary As #1
Get #1, , Lvarbin
Close #1
' Convert to variant to PUT.
LvarBinData = Lvarbin
PstrTargetURL = sharepointFileName
' Put the data to the server, false means synchronous.
LobjXML.Open "PUT", PstrTargetURL, False
' Send the file in.
LobjXML.Send LvarBinData
Next f
Set LobjXML = Nothing
Set fso = Nothing
End Sub
This is VBA code, formatted to mostly work with VBScript, though I could not get this block to transfer properly. As VBA, this can be improved some by assigning data types, etc.
' Read the file into a byte array.
ReDim Lvarbin(LlFileLength)
Open PstrFullfileName For Binary As #1
Get #1, , Lvarbin
Close #1
This is a very old post but a very useful one so thanks to everyone's contribution. This is my version with the early binding. I found that the previous posting didn't work due to VBA assumption of the none declared variable types.
Private Sub cmdUploadToApplicationsAndApprovals_Click()
Dim strSharePointUrl As String
Dim strSharePointFileName As String
Dim lngFileLength As Long
Dim bytBinary() As Byte
Dim objXML As XMLHTTP
Dim varBinData As Variant
Dim strFullfileName As String
Dim strTargetURL As String
Dim fso As FileSystemObject
Set fso = New FileSystemObject
Dim folder As folder
Dim file As file
Dim strFolder As String
strFolder = CurrentProject.Path & "\Upload\"
'This has not been successfully tested using an "https" connection.
strSharePointUrl = "http://sps.mysite.ca/subsite/DocLib/"
Set objXML = New XMLHTTP 'CreateObject("Microsoft.XMLHTTP")
Set folder = fso.GetFolder(strFolder)
For Each file In folder.Files
strSharePointFileName = strSharePointUrl & file.Name
strFullfileName = strFolder & file.Name
lngFileLength = FileLen(strFullfileName) - 1
'Read the file into a byte array.
ReDim bytBinary(lngFileLength)
Open strFullfileName For Binary As #1
Get #1, , bytBinary
Close #1
'Convert to variant to PUT.
varBinData = bytBinary
strTargetURL = strSharePointFileName
'Put the data to the server, false means synchronous.
objXML.Open "PUT", strTargetURL, False
'Send the file in.
objXML.Send varBinData
'Now Update the metadata
Next file
'Clean up
Set objXML = Nothing
Set fso = Nothing
MsgBox "Done"
End Sub
FYI the above code required 2 references.
1. Microsoft XML, v6.0
2. Microsoft Scripting Runtime
Hope this helps improve on the already brilliant answer!!