I'm just getting started on learning VBA and am a bit stumped on the following. I'd be grateful for your assistance.
With the following I'm getting: Compile Error: Duplication in Current Scope after ElseIf (ActiveSheet.Name) = "BA Tracker" Then at line folderPathWithName As String.
My assumption had been that what's in the initial If wouldn't impact the subsequent ElseIf. If that isn't the case then I'm really not sure what to take out of the ElseIf to make this work.
Thanks for your help.
Sub CopyFile()
Dim oFSO As Object
Dim SourceFile As String
Dim DestinationFolder As String
Dim startPath As String
Dim myName As String
Dim FileYear As String
Dim FileMonth As String
Dim AgentName As String
Dim Agreement As String
Dim CallDate As String
Dim wb As Workbook
Dim ws1112 As Worksheet
Dim ws2221 As Worksheet
Dim s As String
Dim r As String
Dim cst As String
Dim cd As String
Dim ass As String
Dim ty As String
Dim an As String
Dim ss As String
Dim si As String
Dim sour As String
FileYear = Range("A2")
FileMonth = Range("A3")
AgentName = Range("D1")
Agreement = Range("D2")
CallDate = Range("D3")
If (ActiveSheet.Name) = "Sitel Audit" Then
startPath = "C:\Users\matthew.varnham\Desktop\QA Improvements\" & FileYear & "\" & FileMonth & "\"
myName = ActiveSheet.Range("D1").Text ' Change as required to cell holding the folder title
' check if folder exists, if yes, end, if not, create
Dim folderPathWithName As String
folderPathWithName = startPath & Application.PathSeparator & myName
If Dir(folderPathWithName, vbDirectory) = vbNullString Then
MkDir folderPathWithName
End If
Set oFSO = CreateObject("Scripting.FileSystemObject")
SourceFile = "C:\Users\matthew.varnham\Desktop\QA Improvements\Customer service Inbound scorecard v9.xlsm"
DestinationFolder = "C:\Users\matthew.varnham\Desktop\QA Improvements\" & FileYear & "\" & FileMonth & "\" & AgentName & "\"
oFSO.CopyFile Source:=SourceFile, Destination:=DestinationFolder & "\" & AgentName & " - " & Agreement & ".xlsm"
ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell.Offset(0, 12), Address:=("C:\Users\matthew.varnham\Desktop\QA Improvements\" & FileYear & "\" & FileMonth & "\" & AgentName & "\" & AgentName & " - " & Agreement & ".xlsm"), TextToDisplay:="OPEN"
Set ws1112 = Sheets("Sitel Audit")
s = ws1112.Range("D1").Value 'Agent Name
r = ws1112.Range("D3").Value 'Call Date
cst = ws1112.Range("D4").Value 'Call Start Time
cd = ws1112.Range("D5").Value 'Call Duration
ass = ws1112.Range("D6").Value 'Assessor Initials
ty = ws1112.Range("D7").Value 'Call Type
an = ws1112.Range("D2").Value 'Agreement Number
ss = ws1112.Range("D8").Value 'Sitel Score
si = ws1112.Range("E1").Value & FileYear & "\" & FileMonth & "\" & AgentName & "\" 'Sitel QA Folder
sour = ws1112.Range("A4").Value 'Sitel as Source
Set wb = Workbooks.Open("C:\Users\matthew.varnham\Desktop\QA Improvements\" & FileYear & "\" & FileMonth & "\" & AgentName & "\" & AgentName & " - " & Agreement & ".xlsm")
Set ws2221 = wb.Sheets("Observation Sheet")
ws2221.Range("B5:C5").Value = s 'Agent Name
ws2221.Range("E5").Value = r 'Call Date
ws2221.Range("F5").Value = cst 'Call Start Time
ws2221.Range("G5").Value = cd 'Call Duration
ws2221.Range("B8:C8").Value = ass 'Assessor Initials
ws2221.Range("B11:C11").Value = ty 'Call Type
ws2221.Range("E8:G8").Value = an 'Agreement Number
ws2221.Range("D4").Value = ss 'Sitel Score
ws2221.Range("G51").Value = si 'Sitel QA Folder
ws2221.Range("C3").Value = sour 'Sitel as Source
ElseIf (ActiveSheet.Name) = "BA Tracker" Then
startPath = "C:\Users\matthew.varnham\Desktop\QA Improvements\BA Tracker\" & FileYear & "\" & FileMonth & "\"
myName = ActiveSheet.Range("D1").Text ' Change as required to cell holding the folder title
' check if folder exists, if yes, end, if not, create
Dim folderPathWithName As String
folderPathWithName = startPath & Application.PathSeparator & myName
If Dir(folderPathWithName, vbDirectory) = vbNullString Then
MkDir folderPathWithName
End If
Set oFSO = CreateObject("Scripting.FileSystemObject")
SourceFile = "C:\Users\matthew.varnham\Desktop\QA Improvements\Customer service Inbound scorecard v9.xlsm"
DestinationFolder = "C:\Users\matthew.varnham\Desktop\QA Improvements\BA Tracker\" & FileYear & "\" & FileMonth & "\" & AgentName & "\"
oFSO.CopyFile Source:=SourceFile, Destination:=DestinationFolder & "\" & AgentName & " - " & Agreement & ".xlsm"
ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell.Offset(0, 13), Address:=("C:\Users\matthew.varnham\Desktop\QA Improvements\BA Tracker\" & FileYear & "\" & FileMonth & "\" & AgentName & "\" & AgentName & " - " & Agreement & ".xlsm"), TextToDisplay:="OPEN"
Set ws1112 = Sheets("BA Tracker")
s = ws1112.Range("D1").Value 'Agent Name
r = ws1112.Range("D3").Value 'Call Date
cst = ws1112.Range("D4").Value 'Call Start Time
cd = ws1112.Range("D5").Value 'Call Duration
ass = ws1112.Range("D6").Value 'Assessor Initials
ty = ws1112.Range("D7").Value 'Call Type
an = ws1112.Range("D2").Value 'Agreement Number
ss = ws1112.Range("D8").Value 'Sitel Score
si = ws1112.Range("E1").Value & FileYear & "\" & FileMonth & "\" & AgentName & "\" 'Sitel QA Folder
sour = ws1112.Range("A4").Value 'Sitel as Source
Set wb = Workbooks.Open("C:\Users\matthew.varnham\Desktop\QA Improvements\BA Tracker\" & FileYear & "\" & FileMonth & "\" & AgentName & "\" & AgentName & " - " & Agreement & ".xlsm")
Set ws2221 = wb.Sheets("Observation Sheet")
ws2221.Range("B5:C5").Value = s 'Agent Name
ws2221.Range("E5").Value = r 'Call Date
ws2221.Range("F5").Value = cst 'Call Start Time
ws2221.Range("G5").Value = cd 'Call Duration
ws2221.Range("B8:C8").Value = ass 'Assessor Initials
ws2221.Range("B11:C11").Value = ty 'Call Type
ws2221.Range("E8:G8").Value = an 'Agreement Number
ws2221.Range("D4").Value = ss 'Sitel Score
ws2221.Range("G51").Value = si 'Sitel QA Folder
ws2221.Range("C3").Value = sour 'Sitel as Source
End If
Workbooks("SITEL - Inbound Tracker.XLSM").Close SaveChanges:=True
End Sub
You are declaring the variable folderPathWithName twice - once inside in the If block, and then within the 'ElseIf` block.
Just delete the line Dim folderPathWithName As String from within the ElseIf block, and move the line Dim folderPathWithName As String from within the If block to be with all of the other variable declarations.
I would suggest that you always declare all of your variables at the start of the procedure, rather than when you think that you will need them. This stops this from happening, and also keeps your code tidy.
Regards,
Related
I'm having an issue with my code:
Sub lalalala ()
Dim s5 As Worksheet
Set s5 = ThisWorkbook.Sheets("Test")
Dim DesktopPath As String
Dim DesktopPathMAIN As String
Dim DesktopPathSUB As String
Dim file As String
Dim sfile As String
Dim sDFolder As String
Dim oFSO As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
DesktopPath = Environ("USERPROFILE") & "\Desktop\"
DesktopPathMAIN = DesktopPath & "THE FINAL TEST"
If Dir(DesktopPathMAIN, vbDirectory) = "" Then
Shell ("cmd /c mkdir """ & DesktopPathMAIN & """")
End If
lastrow = s5.Range("B" & s5.Rows.Count).End(xlUp).Row
Set rng = s5.Range("B1:B" & lastrow)
For Each c In rng
If Dir(DesktopPathMAIN & "\" & c.Offset(, 5).Value, vbDirectory) = "" Then
Shell ("cmd /c mkdir """ & DesktopPathMAIN & "\" & c.Offset(, 5).Value & """")
End If
Next c
lastrow = s5.Range("G" & s5.Rows.Count).End(xlUp).Row
Set rng = s5.Range("G1:G" & lastrow)
For Each c In rng
sDFolder = DesktopPathMAIN & "\" & c.Value & "\"
sfile = s5.Range("H1").Value & c.Offset(, -2).Value
Call oFSO.CopyFile(sfile, sDFolder)
Next c
End Sub
When i run the macro it causes error code 76, but if i run again it works perfectly. I realized it happens when the cell changes the value of the destination folder at this line sfile = s5.Range("H1").Value & c.Offset(, -2).Value.
But it only happens 1 time, if i run again it works perfectly.
How can i fix that?
thank you
So i have found 2 macros which i want to use to save and create a back up files for the said file.
The Macro which i want to primarily use is this one:
Sub DateFolderSave()
Dim strGenericFilePath As String: strGenericFilePath = "D:\"
Dim strYear As String: strYear = Year(Date) & "\"
Dim strMonth As String: strMonth = MonthName(Month(Date)) & "\"
Dim strDay As String: strDay = Day(Date) & "\"
Dim strFileName As String: strFileName = "_Dispatch Process_"
Application.DisplayAlerts = False
' Check for year folder and create if needed
If Len(Dir(strGenericFilePath & strYear, vbDirectory)) = 0 Then
MkDir strGenericFilePath & strYear
End If
' Check for month folder and create if needed
If Len(Dir(strGenericFilePath & strYear & strMonth, vbDirectory)) = 0 Then
MkDir strGenericFilePath & strYear & strMonth
End If
' Check for date folder and create if needed
If Len(Dir(strGenericFilePath & strYear & strMonth & strDay, vbDirectory)) = 0 Then
MkDir strGenericFilePath & strYear & strMonth & strDay
End If
' Save File
ActiveWorkbook.SaveAs FileName:= _
strGenericFilePath & strYear & strMonth & strDay & strFileName, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Application.DisplayAlerts = True
' Popup Message
MsgBox "File Saved As: " & vbNewLine & strGenericFilePath & strYear & strMonth & strDay & strFileName
End Sub
So i found this another Macro which make continuous back up of the files and has a custom format to a file name
Sub Save_Backup(ByVal Backup_Folder_Path As String)
Dim fso As Object
Dim ExtensionName As String, FileName As String
Dim wbSource As Workbook
Set fso = CreateObject("Scripting.FileSystemObject")
Set wbSource = ThisWorkbook
ExtensionName = fso.GetExtensionName(wbSource.Name)
FileName = Replace(wbSource.Name, "." & ExtensionName, "")
fso.CopyFile ThisWorkbook.FullName, _
fso.BuildPath(Backup_Folder_Path, FileName & " (" & Format(Now(), "dd-mmm-yy hh.mm AM/PM") & ")." & ExtensionName)
Set fso = Nothing
Set wbSource = Nothing
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Call Save_Backup("C:\Users\admin\Downloads\Back Up\New Backup")
End Sub
So i want to create back up like the first macro(i.e. Folder inside a folders for the specific date) but want to have a continuous stream of files for back up(i.e. Want the date folder to create new save file each time i save the Document)
Is there a way to combine both these macros?
I have a macro in an Excel Workbook, that is connected to a button that says Export
When I click the button, it triggers the Export XML dialog and I have to manually search for a folder to export it into and enter the filename.
Since the folders in my Documents are named exactly the same as the value of the Cell A24, i would like it to direct itself into the correct folder and suggest me a filename based on the value of the Cell A24 with some extra text behind it.
So far i have this in the VBA:
Public Sub ExportToXML()
Dim strFilePath As String
Dim POFilePath As String
Dim FOFilePath As String
Dim POFileName As String
Dim FOFileName As String
Dim XMLDoc As MSXML2.DOMDocument
Dim xNode As MSXML2.IXMLDOMNode
Dim xAttribute As MSXML2.IXMLDOMAttribute
Dim xElement As MSXML2.IXMLDOMElement
Dim xElementRoot As MSXML2.IXMLDOMElement
Application.ScreenUpdating = False
MainSheetName = ActiveSheet.Name
POFilePath = "C:\Users\admin\Desktop\" & Range("A24")
FOFilePath = "C:\Users\admin\Desktop\" & Range("D22") & " " & Range("A22")
POFileName = "_report " & Range("D13").value & " " & Range("F13").value & ".xml"
FOFileName = "_report " & Range("D13").value & " " & Range("F13").value & ".xml"
If Range("A24").value = "0" Then
strFilePath = Application.GetSaveAsFilename(FOFilePath & FOFileName, fileFilter:="XML files (*.xml),*.xml", Title:="Save FileAs...")
Else
strFilePath = Application.GetSaveAsFilename(POFilePath & POFileName, fileFilter:="XML files (*.xml),*.xml", Title:="Save FileAs...")
End If
If strFilePath = "False" Then Exit Sub
This gives me the right filename suggestion, but it doesn't direct me to the folder and goes to Desktop.
Any help would be appriciated!
EDIT:
I tried merging the Strings together a bit more and came up with this:
Public Sub ExportToXML()
Dim strFilePath As String
Dim POFilePath As String
Dim FOFilePath As String
Dim XMLDoc As MSXML2.DOMDocument
Dim xNode As MSXML2.IXMLDOMNode
Dim xAttribute As MSXML2.IXMLDOMAttribute
Dim xElement As MSXML2.IXMLDOMElement
Dim xElementRoot As MSXML2.IXMLDOMElement
Application.ScreenUpdating = False
MainSheetName = ActiveSheet.Name
POFilePath = "C:\Users\admin\Desktop\" & Range("A24") & Range("A24").value & "_report " & Range("D13").value & " " & Range("F13").value & ".xml"
FOFilePath = "C:\Users\admin\Desktop\" & Range("D22") & " " & Range("A22") & "_report " & Range("D13").value & " " & Range("F13").value & ".xml"
If Range("A24").value = "0" Then
strFilePath = Application.GetSaveAsFilename(FOFilePath, fileFilter:="XML files (*.xml),*.xml", Title:="Save FileAs...")
Else
strFilePath = Application.GetSaveAsFilename(POFilePath, fileFilter:="XML files (*.xml),*.xml", Title:="Save FileAs...")
End If
If strFilePath = "False" Then Exit Sub
The problem is, that VBA thinks that in:
POFilePath = "C:\Users\admin\Desktop\" & Range("A24") & Range("A24").value & "_report " & Range("D13").value & " " & Range("F13").value & ".xml"
the first Range("A24") belongs to the filename part and doesn't continue on with the filepath. So if the value in A24 was "test", then this suggests saving the xml to Desktop with the filename testttest_report 11 2020
I've created a macro that distributes a group of files into various subfolders. However, I'm getting a "file already exists" error when trying to move the file. It occurs on the 2nd and 3rd oFSO.movefile statements. Any Ideas? I tried adding a "\" to the end of the filename but then it gives me a type mismatch error?
PS. please bear with me, I don't have any formal training in VBA.
thanks!
Sub DistributeDD()
MsgBox ("To use this Macro, Place all loan numbers you want to create folders for in column A starting at A1 and the sponsor in column B or C")
SourceFolder = InputBox("Paste the Path where the files are located")
Dim oFSO
Dim oFolder As Object
Dim oFile As Object
Dim NewFolder As String
Dim myRange As Range
Dim i As Long
Dim TestString As String
LastRow = Range("A" & Rows.Count).End(xlUp).Row
Dim subfolder As String
Dim Sponsor As String
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(SourceFolder)
For i = 1 To LastRow
LoanID = Cells(i, 1).Value
Sponsor = Cells(i, 2).Value
Sponsor2 = Cells(i, 3).Value
For Each oFile In oFolder.Files
TestString = oFile.Name
'Populate Collateral File
If InStr(UCase(TestString), UCase(LoanID)) > 0 Then
NewFolder = LoanID
subfolder = IdentifySubfolder(TestString)
createNewDirectory (SourceFolder & "\" & NewFolder)
createNewDirectory (SourceFolder & "\" & NewFolder & "\" & subfolder)
oFSO.movefile Source:=oFile, Destination:=SourceFolder & "\" & NewFolder & "\" & subfolder & "\"
End If
'Populate Sponsor
If InStr(UCase(TestString), UCase(Sponsor)) > 0 Then
NewFolder = LoanID
subfolder = IdentifySubfolder(TestString)
createNewDirectory (SourceFolder & "\" & NewFolder)
createNewDirectory (SourceFolder & "\" & NewFolder & "\" & Sponsor)
oFSO.movefile Source:=oFile, Destination:=SourceFolder & "\" & NewFolder & "\" & Sponsor
MsgBox (TestString)
End If
'Populate Sponsor2
If InStr(UCase(TestString), UCase(Sponsor)) > 0 Then
NewFolder = LoanID
subfolder = IdentifySubfolder(TestString)
createNewDirectory (SourceFolder & "\" & NewFolder)
createNewDirectory (SourceFolder & "\" & NewFolder & "\" & Sponsor2)
createNewDirectory (SourceFolder & "\" & NewFolder & "\" & Sponsor2 & "\" & subfolder)
oFSO.movefile Source:=oFile, Destination:=SourceFolder & "\" & NewFolder & "\" & Sponsor2
End If
Next oFile
Next i
Set oFolder = Nothing
Set oFSO = Nothing
End Sub
Is it possible that columns Sponsor (2) and Sponsor2 (3) have the same information? If so, the folder created under the SourceFolder\NewFolder will have the same name.
Also, I don't know why you're testing those columns with the file's name, but at line 42 you're testing with 'Sponsor' again.
If InStr(UCase(TestString), UCase(Sponsor)) > 0 Then
Depending on your data, it might be the source of the problem.
I'm trying to search for a file, in d:\ folder with the name Division_Application_Partner.xlsx where Division Application and Partner are variables holding string values.
This is the code I gave:
Set WorkbookPath = Dir(path & Division + "_" + Application + "_" + TradingPartner + ".xlsx")`enter code here`
It throws an error saying " Compile Error: Type Mismtach "
Is the name of the file im giving wrong
Here's the code:
Dim WorkbookPath As WorkBook
Dim path as String
Division = Range("C11").Value
Application = Range("C15").Value
TradingPartner = Range("C19").Value
path = "d:\"
'MsgBox (path)
'MsgBox (Division)
'MsgBox (Application)
MsgBox (TradingPartner)
If Len(Dir(path & Division & "_" & Application & "_" & TradingPartner & ".xlsx")) = 0 Then
Set WorkbookPath = Division & "_" & Application & "_" & TradingPartner & ".xlsx"
End If
I tried concatenating using & like you suggested. Still it shows the same error.
You try assign string to object, this why you getting an error
Dim WorkbookPath As WorkBook
Better try
Dim myWkb as Workbook
Set myWkb = Workbooks.Open(your_concat_string)
and dont use reserved words
Application
Finally
Sub test()
Dim wkbExternWorkbook As Workbook
Dim strPath As String
Dim strDivision As String, strApplication As String, strTradingPartner As String
strDivision = Range("C11").Value
strApplication = Range("C15").Value
strTradingPartner = Range("C19").Value
strPath = "D:\"
If Len(Dir(strPath & strDivision & "_" & strApplication & "_" & strTradingPartner & ".xlsx")) <> 0 Then
Set wkbExternWorkbook = Workbooks.Open(strPath & strDivision & "_" & strApplication & "_" & strTradingPartner & ".xlsx")
End If
End Sub
I would start with using & exclusively for string concatenation. The use of + is primarily for adding numbers though it can concatenate strings. However, there are all sorts of caveats to that when using option strict and so forth, so you're better off using what was intended.
The other thing you should do is actually output all those variables before attempting to concatenate or pass them to Dir. Something like:
MsgBox "[" & path & "]"
repeated for all the others as well. The output of that may well point to the problem.
Try this:
Sub test()
Dim application As Variant
Dim division As Variant
Dim WorkbookPath As String
Dim tradingpartner As Variant
Dim path As String
division = Range("C11").Value
application = Range("C15").Value
tradingpartner = Range("C19").Value
path = "d:\"
'MsgBox (path)
'MsgBox (Division)
'MsgBox (Application)
MsgBox (tradingpartner)
If Len(Dir(path & division & "_" & application & "_" & tradingpartner & ".xlsx")) = 0 Then
Workbooks.Add
ActiveWorkbook.SaveAs division & "_" & application & "_" & tradingpartner & ".xlsx"
End If
End Sub
You would first add the workbook and then save it using the created name.