How to check whether we can check out a project or not.
projects are stored in sharepoint.
Always this code is printing unable to checkout
Sub macro()
Dim a As Project
Shell "C:\Program Files (x86)\Microsoft Office\Office15\Winproj.exe /s https://inside.com/PWA/QWER/Project.aspx", vbNormalFocus
Sleep 3000
FileOpenEx Name:="<>\" & "ProjectNAME", ReadOnly:=True, DoNotLoadFromEnterprise:=False
Set a = Projects.Item(1)
a.Activate
If (Projects.CanCheckOut(ActiveProject.Name)) Then
Debug.Print "Can check out the project"
Else
Debug.Print "Cannot checkout the project"
End If
End Sub
It will be very helpful
If you need to run the code inside MS-Project VBA, use the Code below:
Sub CheckOutProject(docCheckOut As String)
' Determine whether project can be checked out
If Projects.CanCheckOut(docCheckOut) = True Then
Debug.Print "Can check out the project"
' if you want, you can check it out
Projects.CheckOut docCheckOut
Else
Debug.Print "Cannot checkout the project"
End If
End Sub
Use the Test code below to test it out:
Sub Test()
Dim FullPath As String
' Full Path equals the full SharePoint Path & File name (including extension)
FullPath = "http://share.Comapny.com/sites/Test123/Project%20Documentsnew/Project%20Files/Project_1.mpp"
CheckOutProject FullPath ' call the Sub
End Sub
Related
I'm using these two functions to create project folders on startup. In the beginning I'm creating only one folder named ProjectName but now there's other folders on the same level with ProjectName named ProjectName_Inputs, ProjectName_Files, ProjectName_Outputs. I want to create them with my below code.
I wonder how can I adapt this to my code. I mean, is it possible to use an array or for loop etc.? path = [/ProjectName, ProjectName_Inputs, ProjectName_Files, ProjectName_Outputs] I don't know if it's possible?
Or can you suggest a more logical way to create them?
Sub CreateFolders()
Dim fso As New FileSystemObject
If Functions.FolderExists(path) Then
Exit Sub
Else
On Error GoTo FolderNotBuilt
fso.CreateFolder path ' could there be any error with this, like if the path is really screwed up?
Exit Sub
End If
FolderNotBuilt:
MsgBox "A folder could not be created for the following path: " & path & ". Check the path name and try again."
FolderCreate = False
Exit Sub
End Sub
This is the function that controls whether or not the directory created before
Function FolderExists(ByVal path As String) As Boolean
FolderExists = False
Dim fso As New FileSystemObject
If fso.FolderExists(path) Then FolderExists = True
End Function
Edited to amend a typo (End With missing) and change Resume to Resume Nextand skip the possibly screwed up path
I’d go like follows
Sub CreateFolders()
Dim path As Variant
With CreateObject("Scripting.FileSystemObject") 'create and reference a FileSystemObject object
For Each path In Array("path1*\", "path2", "path3")
If Not .FolderExists(path) Then 'loop through paths in array
On Error GoTo FolderNotBuilt
.CreateFolder path ' could there be any error with this, like if the path is really screwed up?
End If
Next
End With
Exit Sub
FolderNotBuilt:
MsgBox "A folder could not be created for the following path: " & vbCrLf & vbCrLf & path & vbCrLf & "Check the path name and try again."
Resume Next
End Sub
I would like to export/ maintain/ manage a text file backup of modules in my personal macro workbook personal.xlsb using VBA.
I cannot find an object library which refers to the modules themselves on msdn. Could someone point me in the right direction on this please?
Using Excel 2013.
You need to add Visual Basic for Application Extensibility X.X reference; or:
Sub load_reference_1()
ThisWorkbook.VBProject.References.AddFromGuid "{0002E157-0000-0000-C000-000000000046}", 5, 3
end sub
Sub Load_reference_2()
ThisWorkbook.VBProject.References.AddFromFile "C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
end sub
Example:
Sub Macromodule_copy1()
ThisWorkbook.VBProject.VBComponents("Macroos").Export "E:\Macroos.bas"
With Workbooks.Add
.VBProject.VBComponents.Import "E:\Macroos.bas"
End With
End Sub
Further examples and source: Snb-Vba -awesome examples!-
I do exactly this, with my personal.xlsb and also with other macro workbooks.
I save the text files into a "VBA" subdirectory and put them into version control to keep track of the changes.
I was inspired by Mass importing modules & references in VBA which references https://www.rondebruin.nl/win/s9/win002.htm
I have a module called WriteBas containing this code:
Attribute VB_Name = "WriteBas"
Option Explicit
Sub WriteAllBas()
' Write all VBA modules as .bas files to the directory of ThisWorkbook.
' Implemented to make version control work smoothly for identifying changes.
' Designed to be called every time this workbook is saved,
' if code has changed, then will show up as a diff
' if code has not changed, then file will be same (no diff) with new date.
' Following https://stackoverflow.com/questions/55956116/mass-importing-modules-references-in-vba
' which references https://www.rondebruin.nl/win/s9/win002.htm
Dim cmp As VBComponent, cmo As CodeModule
Dim fn As Integer, outName As String
Dim sLine As String, nLine As Long
Dim dirExport As String, outExt As String
Dim fileExport As String
On Error GoTo MustTrustVBAProject
Set cmp = ThisWorkbook.VBProject.VBComponents(1)
On Error GoTo 0
dirExport = ThisWorkbook.Path + Application.PathSeparator + "VBA" + Application.PathSeparator
For Each cmp In ThisWorkbook.VBProject.VBComponents
Select Case cmp.Type
Case vbext_ct_ClassModule:
outExt = ".cls"
Case vbext_ct_MSForm
outExt = ".frm"
Case vbext_ct_StdModule
outExt = ".bas"
Case vbext_ct_Document
Set cmo = cmp.CodeModule
If Not cmo Is Nothing Then
If cmo.CountOfLines = cmo.CountOfDeclarationLines Then ' Ordinary worksheet or Workbook, no code
outExt = ""
Else ' It's a Worksheet or Workbook but has code, export it
outExt = ".cls"
End If
End If ' cmo Is Nothing
Case Else
Stop ' Debug it
End Select
If outExt <> "" Then
fileExport = dirExport + cmp.name + outExt
If Dir(fileExport) <> "" Then Kill fileExport ' From Office 365, Export method does not overwrite existing file
cmp.Export fileExport
End If
Next cmp
Exit Sub
MustTrustVBAProject:
MsgBox "Must trust VB Project in Options, Trust Center, Trust Center Settings ...", vbCritical + vbOKOnly, "WriteAllBas"
End Sub
and in my ThisWorkbook object, the BeforeSave event handler calls it each time the workbook is saved.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
WriteAllBas
End Sub
There's a second or two of overhead each time the workbook is saved.
Note: Under Office 2016 and earlier versions I didn't need to delete (Kill) the text file before exporting, but under Office 365 the Export method fails if the file exists.
I just save a date/timestamped copy of PERSONAL.xlsb to a backup drive location using the following code.
Sub PersonalBckup()
Const dstBak As String = "H:\PERSONAL MACROS\" 'change path to suit
Const dstBak2 As String = "D:\PERSONAL Macros\"
On Error Resume Next 'if either of the drives are not present, skip error.
Application.DisplayAlerts = False 'turn off warning popups
With Workbooks("PERSONAL.xlsb") 'name of your PERSONAL.xlsb file
.SaveCopyAs dstBak & "PERSONAL" & " as of " & Format(Now(), "YYYYMMDD_hhmmAMPM") & ".xlsb"
.SaveCopyAs dstBak2 & "PERSONAL" & " as of " & Format(Now(), "YYYYMMDD_hhmmAMPM") & ".xlsb"
.Save
End With
Application.DisplayAlerts = True 'Turn on warning popups
The backed-up file is saved with a date/timestamp: "PERSONAL as of 20180512_0136PM.xlsb"
I know this doesn't exactly answer the question, but perhaps it's still helpful. You can easily save all modules into a pdf by rigth clicking the modules folder and clicking print (and then clicking setup to change to print to pdf) . This won't give you a specific exported file that can be easily imported back in per se, but it keeps a safely saved file that you can always go back and reference should anything go wrong in your code. There's probably a way to automate this (or at least make it a one-time click when you save), but I haven't figured that out yet.
I currently have the following code to call a vbs file that is in a folder within Program Files. It was originally in a different location (within the same folder) and it would work, but now there is a padlock symbol next to the folder within Program Files, and after changing the location (VBA updated for this as well), it won't call the file. I'm wondering why this is happening.
Sub ChangeThemeBasic()
Dim filespe As String
filespe = "cmd.exe /c C:\Program Files\Theme Changer\ChangeTheme.vbs"
X = Shell(filespe, 1)
End Sub
EDIT:
This works for some reason, I don't know why though:
Sub Test()
Shell "Explorer.exe ""C:\Program Files\Theme Changer\ChangeTheme.vbs""",1
End Sub
From comments
Sub ChangeThemeBasic()
Dim filespe As String
filespe = "cmd.exe /c " & Environ("AppData") & "\Theme Changer\ChangeTheme.vbs"
X = Shell(filespe, 1)
End Sub
Preferably I would like to incorporate it into a user form as a command button.
The code I've tried so far:
Private Sub graphButton_Click()
Dim mtbPath As String: mtbPath = "S:\MetLab (Protected)\MetLab Operations\Lab
Reports\Forgings"
Call Shell(Environ$("COMSPEC") & " /s " & mtbPath & "\Updater.mtb", vbNormalFocus)
End Sub
Where Updater.mtb is the actual file I would like to execute. This seems to only open Command prompt- which is not what I'm looking for
Copy and paste into a VBA Module:
Sub Run_Minitab_Macro()
Set MtbApp = CreateObject("Mtb.Application")
With MtbApp.ActiveProject
'This lets you open an excel file from your desktop:
.ExecuteCommand "WOpen 'C:\Users\you\Desktop\TEMP1.xlsx'; FType; Excel."
'Save the minitab project to my documents:
.ExecuteCommand "Save 'C:\Users\you\My Documents\Test.MPJ'; Project; Replace."
'On Error Resume Next
.ExecuteCommand "%MacroFile" 'This is a .MAC macro file stored in the my
'documents folder saved to here,
'any command-line command can go here though
'On Error GoTo 0
.ExecuteCommand "Save."
End With
End Sub
I mapped an intranet location using the File Explorer. i.e. mapped http://intranet.XXXXXXX.com/mydir/ to M:\
I'm using the Dir function to test if a file is present in that location:
Dim FileExists as Boolean
FileExists = Dir("M:\myfile") <> ""
If FileExists Then MsgBox "File found in M:"
I run that macro on Excel 2007 and it Works Fine. When I run it on Excel 2010 though, Dir("M:\myfile") always returns "", even if the file is present in the specified location. I can´t find a solution that will work on both Excel versions. Any ideas?
You may add file extension as a wildcard character at the end of filepath. I gave a try in excel 2010 and it worked for me.
Dim FileExists As Boolean
FileExists = Dir("D:\myfile" & "*.txt") <> ""
If FileExists Then MsgBox "File found in M:"
I found that if I use the full network name, it works first go. This wasn't just in VBA, but also some shortcuts also - they returned "File could not be found".
Changing from the mapped shortcut, e.g.
Y:\Projects\Proj1\File1.xlsx
to the full mapped path, e.g.
\\server\Department\Projects\Proj1\File1.xlsx
Fixed the problem
Here is how to use FSO to do what you want:
Option Explicit
Function test_it()
'Test the Function - must pass the file path and name
Debug.Print Does_File_Exist("C:\temp\form1.txt")
End Function
Private Function Does_File_Exist(sFullPath) As Boolean
' Will return True or False if file exists.
' Provide the fully qualified path and file name.
' You can disable the MsgBox displays after testing
Dim oFs As New FileSystemObject
Dim oFile As File
Set oFs = New FileSystemObject
If oFs.FileExists(sFullPath) Then
Does_File_Exist = True
MsgBox "Found file: " & sFullPath
Else
Does_File_Exist = False
MsgBox "File not found: " & sFullPath
End If
Set oFs = Nothing
End Function