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
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
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"
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.
My code asks the user to input a file name. We'll say we have 5 text files in directory "C:\Users\aUser\Desktop\myFolder". These text files are named A, B, C, D, and E.
If the text file exists, then I would like to write over the contents with a script I've already made. If the text file does not exist, I would like to make one with the file name they inputted, and populate it [with the script I've already written].
Thanks for your help.
The way you explain it, it seems that the easiest workflow would be:
1) Delete the file if exists
Sub test()
Dim FSO As FileSystemObject
Dim sPath As String
sPath = "U:\Test.txt"
Set FSO = New FileSystemObject
If FSO.FileExists(sPath) Then
FSO.DeleteFile (sPath)
End If
End Sub
Copy the script (I assume also a txt file) into the path:
FileCopy "U:\Script", sPath
If you have the script in a string variable:
Set txtFile = FSO.CreateTextFile(sPath, True)
txtFile.WriteLine(sText)
FSO.Close
End Sub
If the script is contained in an array, you can loop through the array and produce multiple writelines.
Don't forget to reference the Microsoft Scripting Runtime library.
Something like this
locates the folder for the logged on user regardless of OS
checks that the user input file is contained in a master list (held by StrFiles)
then either creates a new file if it doesn't exist, or
provides a logic branch for you to add your overrwrite script
Sub
code
GetFiles()
Dim wsShell As Object
Dim objFSO As Object
Dim objFil As Object
Dim strFolder As String
Dim StrFile As String
Dim StrFiles()
StrFiles = Array("A.txt", "B.txt", "C.txt")
Set wsShell = CreateObject("wscript.shell")
strFolder = wsShell.specialFolders("Desktop") & "\myFolder"
StrFile = Application.InputBox("Please enter A.txt, B.txt", "File Selection", , , , , 2)
If IsError(Application.Match(StrFile, StrFiles, 0)) Then
MsgBox StrFile & " is invalid", vbCritical
Exit Sub
End If
If Len(Dir(strFolder & "\" & StrFile)) = 0 Then
'make file
Set objFSO = CreateObject("scripting.filesystemobject")
Set objFil = objFSO.createtextfile(strFolder & "\" & StrFile, 2)
objFil.Close
Else
'write over file
'add your code here
End If
End Sub
I'd like to save a file in the following example folder:
C:\MainFolder\Subfolder1\Subfolder2\Subfolder3_A_abc_123
There are other subfolders in the folder where I'd like the file be saved, like:
Subfolder_B_xyz_456
Subfolder_C_rst_789
etc
The thing is that I want to find a folder on the the path all the way up to: "Subfolder3_", the "A" will be fetched from a range in a sheet and the "_abc_123", I do not want to match.
Does anyone have a clever FSO example or other creative sollution? I'm new to programming so any suggestion is appreciated.
Thanks on advance.
PythonStyle
Updated question to ho1:
This is the code:
Sub Create_WorkB_Input()
Dim wbBook1 As Workbook
Dim wbBook2 As Workbook
Dim shTemp1 As Worksheet
Dim shTemp2 As Worksheet
Dim shTemp_admin As Worksheet
Dim shTSSR_inp1 As Worksheet
Dim shTSSR_inp2 As Worksheet
Dim strVersion As String
Dim strPrep As String
Dim Datecr As Date
Dim strComment As String
Dim intBatch As Integer
Dim strSiteID As String
Dim strClusterID As String
Dim strPath As String
Dim fso As New FileSystemObject
Dim flds As Folders
Dim f As Folder
Set wbBook1 = Workbooks("Name_Input_TEMPLATE_v4.0.xls")
Set wbBook2 = Workbooks("Name_Input_To_xxx.xlsm")
Set shTemp1 = Workbooks("Name_Input_TEMPLATE_v4.0.xls").Sheets("TSSR_Input_sh1")
Set shTemp2 = Workbooks("Name_Input_TEMPLATE_v4.0.xls").Sheets("TSSR_Input_sh2")
Set shTSSR_inp1 = Workbooks("Name_Input_To_xxx.xlsm").Sheets("xxx")
Set shTSSR_inp2 = Workbooks("Name_Input_To_xxx.xlsm").Sheets("yyy")
Set shTemp_admin = Workbooks("Name_Input_TEMPLATE_v4.0.xls").Sheets("www")
shTSSR_inp1.UsedRange.Copy
shTemp1.Paste
shTSSR_inp2.UsedRange.Copy
shTemp2.Paste
intBatch = shTemp1.Range("AQ2").Value
strSiteID = shTemp1.Range("A2").Value
strClusterID = shTemp1.Range("B2").Value
strComment = InputBox(Prompt:="Insert comments.", Title:="INSERT COMMENTS", Default:="New site - batch " & intBatch & " ref email fr Me dato")
With shTemp_admin
.Range("A18").FormulaR1C1 = "4.0"
.Range("B18").Value = "John Doe"
.Range("C18").Value = Date
.Range("D18").Value = strComment
End With
strPath = "D:\Path_to_folder\folder1\folder2\folder3\folder4"
Set flds = fso.GetFolder(strPath & "\Folder5_Input_Batch_" & intBatch & "*")
For Each f In flds
If f.Name Like strPath Then
wbBook1.SaveAs Filename:="" + strPath + "\" + "TSSR_Input_" + strClusterID + "_" + strSiteID + "_v4.0.xls", _
FileFormat:=xlNormal, _
Password:="", _
WriteResPassword:="", _
ReadOnlyRecommended:=False, _
CreateBackup:=False
End If
Next
End Sub
I am getting error at this line :
Set flds = fso.GetFolder(strPath & "\Folder5_Input_Batch_" & intBatch & "*")
Could you please have a look at it?
The names of folders and workbooks are changed so they might not make any sense. Only the folder part is important.
Thanks in advance.
Rgds
P
You could just loop through all the subdirectories and for each directory you compare it with the path you want to find. Something like this pseudo code should work:
For each dir in SubDirectories
Dim lookingFor as String
lookingFor = "Subfolder3_" & yourVariable & "*"
If dir.Name Like lookingFor Then ' Note the use of the Like operator here so that it sees the * as a wildcard
' This is the right one
End If
Next
An other, similar, option would be to use regular expressions which are more powerful than Like, but I don't think you'd need that. However, just in case, you can find information about it here: How to Use Regular Expressions in Visual Basic
Nothing wrong with the posted solution. I just thought I would also post another alternative using the Dir() function, which should be a little faster - especially if you have a lot of subdirectories to search.
i.e.
Dim strFoundDir as String
strFoundDir=dir("C:\MainFolder\Subfolder1\Subfolder2\SubFolder3*" & SomeVariable & "*", vbDirectory)
if lenb(strFoundDir)>0 then
'Do the rest of your code
end if