PDA

View Full Version : Tweak VBA to Move SharePoint Files to a Folder in Same Location



Enyala-12
08-13-2014, 09:44 AM
Hello all.
I know this may be a long shot but I will take my chance and hope that I won't get reamed too bad.
I have been given the job to read someone's vba who is a serious expert. I usually record and tweak the code for small to medium automation but I only want to use small parts of the existing VBA with the main function being to move an Excel file on SharePoint to the "Archive" folder in the same location.
I have included partial code below (let me know if more is needed to understand).
When I tweak the code, I get "Compile error: Sub or Function not defined."
Can anyone helpless novice?

Thank you in advance.

If ListOfFilenamesWithPath.Count = 0 Then
MsgBox "No file was found !"
Else
temp = MsgBox("Run Completed for " & ListOfFilenamesWithPath.Count & _
" projects in about " & Round((Timer - Time1) / 60) & _
" minutes. Active excel tab contains new L1 Rollup. Powerpoint window" & _
" contains new L2 Rollup. After sorting the L1 rollup and TOC tabs," & _
" you can copy+paste them into the presentation. The last tab (" & keepsht & ") may help with the TOC. " & _
" Please delete it when you're done.", vbOKOnly, "DATA ROLLED UP!")
updateSP = MsgBox("Updated month files (" & Replace(filesname, oldsufx, newsufx) & ") are ready to be added to " & filesfolder & _
" and the " & filesname & " versions moved to Archive. " & _
" Click Yes if you wish to update SharePoint now or No if you want" & _
" to first look over the files in " & newfldr & " (then you'll need to rerun L1_and_L2_Rollup again).", vbYesNo, _
title:="Ready to Update SharePoint.")
If updateSP = vbYes Then Update_Sharepoint
End If
' MsgBox ("Updated project files are currently stored in " & newfldr & ". Use the Update Sharepoint macro if you are satisfied with them.")
Finish:
'reset to user's original calculation choice
Application.Calculation = keepcalc
End Sub

mancubus
08-14-2014, 01:24 AM
hi and welcome.

creating a small procedure from a larger project is tricky.

you should give the values for the following to the smaller sub:
ListOfFilenamesWithPath
keepsht
filesname
oldsufx
newsufx
keepcalc

and have the called sub in a module:
Update_Sharepoint

does a module contain this sub?

Enyala-12
08-14-2014, 08:40 AM
Thanks for replying mancubus. Yes. It does have the Update_Sharepoint sub.

I kept the following code but now get a "Compile error: Sub or Function not defined" where "ListOfFilenamesWithDestPath" is highlighted.


Private Sub Update_Sharepoint()
' Moves old project excel and ppt files on Sharepoint to there proper archive,
' moves new L2 slide from local drive to proper sharepoint project archive, and
' moves new (next month) project excel file from local drive to sharepoint project folder.
' Jonathan Wetmore, 2012
Dim SrcFile As Variant
Dim DestFile As Variant
Dim pptsrcname As Variant
Dim pptdestname As Variant
Dim newsrcname As Variant
'Check to see if file information is still live
If ListOfFilenamesWithPath.Count < 1 Then
MsgBox ("This macro needs to be run during the same excel session as the L1 and L2 Rollup macro." & _
" Right now it can't find the information on the files. (Sorry) Please re-run the L1 and L2 Rollup Macro.")
Exit Sub
End If
'Check to see if the user REALLY wants to update Sharepoint
filler = ""
If indivppts Then filler = "new L2 ppt file and "
goahead = MsgBox("This macro updates the sharepoint site, archiving each project's current excel" & _
" file, and moving " & filler & "new (next month) excel file" & _
" from the local folder to the sharepoint site. Click yes if you wish to continue (and maybe go get some coffee).", vbYesNo, _
title:="This could take a while, so let's make sure.")

If goahead = vbYes Then
'Go ahead and update Sharepoint
fileindexnum = 0
prevfilename = ".xlsx"
For Each SrcFile In ListOfFilenamesWithPath
fileindexnum = fileindexnum + 1
'check for duplicates
If Replace(SrcFile, ".xlsx", "") = Replace(prevfilename, ".xls", "") Then GoTo skipdup
If Replace(SrcFile, ".xls", "") = Replace(prevfilename, ".xlsx", "") Then GoTo skipdup
'Set archive destination
DestFile = Replace(ListOfFilenamesWithDestPath(fileindexnum), newfldr, Dltr)

'Rename ppt file in Sharepoint Archive if it already exists
On Error Resume Next
Name Replace(DestFile, ".xls", ".ppt") As Replace(DestFile, ".xls", "bak2.ppt")

'Move ppt file in Sharepoint to Archive if it already exists
Name Replace(Replace(SrcFile, newfldr, Dltr), ".xls", ".ppt") As Replace(DestFile, ".xls", "bak1.ppt")

'Move reformatted old excel file to sharepoint Archive
On Error GoTo 0
Name SrcFile As Replace(DestFile, ".xls", "_ref.xls")
'Move unreformatted old excel file on sharepoint to Archive
On Error GoTo 0
Name Replace(SrcFile, newfldr, Dltr) As DestFile

'move new project powerpoint to Sharepoint if it was created
If indivppts Then Name Replace(SrcFile, ".xls", ".ppt") As Replace(DestFile, ".xls", ".ppt")

'move new project excel file to sharepoint
Name Replace(SrcFile, oldsufx, newsufx) As Replace(Replace(SrcFile, oldsufx, newsufx), newfldr, Dltr)
skipdup:
prevfilename = SrcFile
Next SrcFile
On Error GoTo 0
Else
Exit Sub
End If
Beep
'Debug Workbooks(ThisWorkbook.Name).Sheets(Sheets.Count).Range("$A$1").Offset(fileindexnum, 0).Range("A1").Value = ("Name " & Replace(DestFile, ".xls", ".ppt") & " As " & Replace(DestFile, ".xls", "bak2.ppt"))
'Debug Workbooks(ThisWorkbook.Name).Sheets(Sheets.Count).Range("$A$1").Offset(fileindexnum + 100, 0).Range("A1").Value = ("Name " & Replace(Replace(SrcFile, newfldr, Dltr), ".xls", ".ppt") & " As " & Replace(DestFile, ".xls", "bak1.ppt"))
'Debug Workbooks(ThisWorkbook.Name).Sheets(Sheets.Count).Range("$A$1").Offset(fileindexnum + 200, 0).Range("A1").Value = ("Name " & Replace(SrcFile, newfldr, Dltr) & " As " & DestFile)
'Debug Workbooks(ThisWorkbook.Name).Sheets(Sheets.Count).Range("$A$1").Offset(fileindexnum + 300, 0).Range("A1").Value = ("Name " & Replace(SrcFile, ".xls", ".ppt") & " As " & Replace(DestFile, ".xls", ".ppt"))
'Debug Workbooks(ThisWorkbook.Name).Sheets(Sheets.Count).Range("$A$1").Offset(fileindexnum + 400, 0).Range("A1").Value = ("Name " & Replace(SrcFile, oldsufx, newsufx) & " As " & Replace(Replace(SrcFile, oldsufx, newsufx), newfldr, Dltr))
End Sub

westconn1
08-14-2014, 02:35 PM
Sub or Function not defined" where "ListOfFilenamesWithDestPath" is highlighted.
presumably is a globally declared collection, is it dimensioned within the scope of your current code?
has it elsewhere been initialised?
possibly from some filedialog

Enyala-12
08-15-2014, 10:05 AM
Hi westconn1.

I should probably work on starting from scratch. :'(

How would I just move SharePoint files to a SharePoint folder named "archived" in the same location?

Thanks.

snb
08-16-2014, 04:26 AM
or ?


Sub M_snb()
createobject("Scripting.FileSystemObject").CopyFolder "G:\OF\test", "G:\OF\backup\test"
End Sub