Excel VBA Save path/name from cells with variables - vba

I am using cells as the file path and filename to save a copy of my workbook.
Here's the code am using now but it puts spaces in between each cell.
Note only the ActiveSheet.Range cells will have the possibility of being blank
Dim NewWb As Workbook
sFile = Control_Sheet_VB.Range("H2") & "\" & ActiveSheet.Range("H8") & " " & ActiveSheet.Range("E10") & " " & ActiveSheet.Range("D14") & " - Ticket #" & Control_Sheet_VB.Range("B2") & Control_Sheet_VB.Range("C2") & ".xlsm"
Set OldWb = ActiveWorkbook
OldWb.SaveCopyAs sFile
Set NewWb = Workbooks.Open(sFile)
How can I make it so if some of the cells that are used as the file name are blank then it dose not put the extra space in the filename


you may go like this:
sFile = Control_Sheet_VB.Range("H2") & "\" & _
IIf(ActiveSheet.Range("H8") <> "", ActiveSheet.Range("H8") & " ", "") & _
IIf(ActiveSheet.Range("E10") <> "", ActiveSheet.Range("E10") & " ", "") & _
IIf(ActiveSheet.Range("D14") <> "", ActiveSheet.Range("D14") & " ", "") & _
" - Ticket #" & Control_Sheet_VB.Range("B2") & _
Control_Sheet_VB.Range("C2") & ".xlsm"

Related

Access OutPutTo to folder

I have been struggling to output the PDF report to the relevant folder within the server. The error which is showing is
RunTime error 3201, no record found.
Could you please help me to solve it?
Dim RFQNumber As String
Dim InNumber As String
Dim FullReportName As String
Dim path1 As String
RFQNumber = [Forms]![RFQ_Database]![RFQ_ExNumber]
InNumber = [Forms]![RFQ_Database]![RFQ_InNumber]
path1 = "\\AZBAK-FP02\Work\Old Server Data\V&C\" & RFQNumber & "\" & RFQNumber & " " & InNumber & ".pdf"
MsgBox (path1)
DoCmd.OutputTo acOutputReport, "AOrderFCAVienna", "PDFFormat(*.pdf)", path1, False

I believe the ampersand in the directory path is causing the issue.
ath1 = "\\AZBAK-FP02\Work\Old Server Data\V&C\" & RFQNumber & "\" & RFQNumber & " " & InNumber & ".pdf"
^^^
you may need to add chr code
ath1 = "\\AZBAK-FP02\Work\Old Server Data\V" & Chr(38) & "C\" & RFQNumber & "\" & RFQNumber & " " & InNumber & ".pdf"
Inserting a formula containing an ampersand into a cell

How to add an incremental count (version) to a string (file) in Excel/VBA?

I have tried a lot of different things, and it seems like I cannot get it to work. So basically, this is a small piece of my complete code.
I am using Microsoft Scripting Runtime to save the file, using the FileExists() to check if the file actually exist before saving.
This is working fine if I remove the IF-statement/Loop.
However, now it feels like FileExists won´t find the string, MyFilePath, when I run it with the IF/Loop. (getdirsubparentpath is a function)
Dim week, UserName As String
Dim MyFile, MyFilePath As String
Dim version As Integer
' Current week, XX
week = Format(Date, "ww")
' Username, e.g. niclas.madsen
UserName = Environ$("UserName")
' Initials, first letter of last and surname to caps
' e.g. niclas.madsen would be NM
UserName = UCase(Left(UserName, 1) & Mid(UserName, InStr(UserName, ".") + 1, 1))
' fix filename for saving purpose
MyFile = Replace(Replace("SupplierOrganization_W", "", ""), ".", "_") _
& "" _
& week _
& " " _
& UserName _
& ".csv"
'SupplierOrganization_WXX NM
MyFilePath = getDirSubParentPath & MyFile
' Look for the MyFilePath, if it exists then
' Add "-1" after the week number, if 1 exists, add 2, etc.
If Len(Dir(MyFilePath)) <> 0 Then
version = 0
Do
version = version + 1
MyFilePath = Dir(getDirSubParentPath & "SupplierOrganization_W" & week & "-" & version & " " & UserName & ".csv")
Loop Until Len(Dir(MyFilePath)) < 0
End If
Dim tmpFile, tmpFilePath As String
tmpFile = getDirSubParentPath & "tmp_file.txt"
Dim tmpString As String
'Dim fso As New FileSystemObject
Dim fso As Object 'scripting.filesystemobject
Set fso = CreateObject("scripting.filesystemobject")
If fso.FileExists(MyFilePath) = True Then
Application.ScreenUpdating = False
Open MyFilePath For Input As #1
Open tmpFile For Output As #2
tmpString = Input(LOF(1), 1) 'read the entire file
tmpString = Replace(tmpString, (Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
& Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) _
& Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) _
& Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
& Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) _
& Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) _
& Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
& Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) _
& Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) _
& Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
& Chr(34)), "") 'eliminate double quotation and commas in the first line with UTF-8
Print #2, tmpString 'output result
Close #1
Close #2
fso.DeleteFile (MyFilePath) 'delete original file
fso.CopyFile tmpFile, MyFilePath, True 'rename temp file
fso.DeleteFile (tmpFile) 'delete temp file
Application.ScreenUpdating = True
MsgBox "Finished processing file", vbInformation, "Done!"
Else
MsgBox "Cannot locate the file : " & MyFilePath, vbCritical, "Error"
End If
Set fso = Nothing
End Sub
' Get Parent Sub Directory Path
Function getDirSubParentPath()
getDirSubParentPath = ThisWorkbook.Path & Application.PathSeparator & "CSV" & Application.PathSeparator & "Parent" & Application.PathSeparator
End Function

I finally manage to create a solution that seems viable. However, the code could use some cleaning up :) But it gets the job done.
So basically, I am having some issues with the loop. It will return a file named W16-0 (which should actual just be W16). It should only add the "-X" if W16 is found. So the incremental order should be W16, W16-1, W16-2, etc.
What I am doing is that I try to locate if there is a W16-0 and then replace it with W16. Furthermore, it seems like the loop will give me one higher than the amount of files I have. So that is where I also got an error. So if I had a W16-4, it would ask the macro to find and open a file named W16-5, which would obviously not exist.
If somebody could help me clean up the code, I would be really thankful!
Sub RemoveCommasDoubleQ()
'
' Enable a reference to 'Microsft Scripting Runtime'
' under VBA menu option Tools > References
Dim week, UserName As String
Dim MyFile, MyFilePath As String
Dim version As Integer
Dim fso As Object 'scripting.filesystemobject
Set fso = CreateObject("scripting.filesystemobject")
' Current week, XX
week = Format(Date, "ww")
' Username, e.g. niclas.madsen
UserName = Environ$("UserName")
' Initials, first letter of last and surname to caps
' e.g. niclas.madsen would be NM
UserName = UCase(Left(UserName, 1) & Mid(UserName, InStr(UserName, ".") + 1, 1))
' fix filename for saving purpose
MyFile = Replace(Replace("SupplierOrganization_W", "", ""), ".", "_") _
& "" _
& week _
& " " _
& UserName _
& ".csv"
'SupplierOrganization_WXX NM
'MyFilePath = ThisWorkbook.Path & "\CSV\Parent\" & MyFile
MyFilePath = getDirSubParentPath & MyFile
Debug.Print MyFilePath
Debug.Print "BEFORE LOOP"
'version = 1
Do While Len(Dir(MyFilePath)) <> 0
'// If it does, then append a _000 to the name
'// Change _000 to suit your requirement
MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & "-" & version & " " & UserName & ".csv"
'// Increment the counter
version = version + 1
'// and go around again
If MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & "-0" & " " & UserName & ".csv" Then
MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & " " & UserName & ".csv"
Debug.Print MyFilePath
Debug.Print "IF LOOP"
End If
Loop
Debug.Print MyFilePath
Debug.Print "LOOP"
If fso.FileExists(getDirSubParentPath & "SupplierOrganization_W" & week & "-" & version & " " & UserName & ".csv") = False Then
MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & "-" & version - 2 & " " & UserName & ".csv"
MsgBox getDirSubParentPath & "SupplierOrganization_W" & week & "-" & version & " " & UserName & ".csv"
End If
fileName = fso.GetFileName(MyFilePath)
Debug.Print fileName
If MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & "-0" & " " & UserName & ".csv" Then
MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & " " & UserName & ".csv"
Debug.Print MyFilePath
Debug.Print "her it should be 0"
End If
If MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & "-" & " " & UserName & ".csv" Then
MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & "-" & version & " " & UserName & ".csv"
End If
Debug.Print "HER ER VI"
fileName = fso.GetFileName(MyFilePath)
Debug.Print fileName
Dim tmpFile, tmpFilePath As String
tmpFile = getDirSubParentPath & "tmp_file.txt"
Dim tmpString As String
Debug.Print "------"
Debug.Print MyFilePath
If fso.FileExists(getDirSubParentPath & "SupplierOrganization_W" & week & "-0" & " " & UserName & ".csv") = True Then
MsgBox "Found the W-0"
MyFilePath = getDirSubParentPath & "SupplierOrganization_W" & week & " " & UserName & ".csv"
End If
Debug.Print "Found 0?"
Debug.Print MyFilePath
If fso.FileExists(MyFilePath) = True Then
Application.ScreenUpdating = False
Open MyFilePath For Input As #1
Open tmpFile For Output As #2
tmpString = Input(LOF(1), 1) 'read the entire file
tmpString = Replace(tmpString, (Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
& Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) _
& Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) _
& Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
& Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) _
& Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) _
& Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
& Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) _
& Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) _
& Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) & Chr(34) & Chr(44) & Chr(34) _
& Chr(34)), "") 'eliminate double quotation and commas in the first line with UTF-8
Print #2, tmpString 'output result
Close #1
Close #2
fso.DeleteFile (MyFilePath) 'delete original file
fso.CopyFile tmpFile, MyFilePath, True 'rename temp file
fso.DeleteFile (tmpFile) 'delete temp file
Application.ScreenUpdating = True
MsgBox "Finished processing file", vbInformation, "Done!"
Else
MsgBox "Cannot locate the file : " & MyFile, vbCritical, "Error"
End If
Set fso = Nothing
End Sub

How to concatenate _ in vb.net

_ in vb.net is used for line continuation. How to concatenate _ in a text.
I am trying this
aPath.ExeConfigFilename = strAppPath & "\" & Environment.UserName.ToString & Thread.CurrentThread.CurrentCulture.Name.ToString &_& xyzConstants.CONFIG_FILE

Change this:
aPath.ExeConfigFilename = strAppPath & "\" & Environment.UserName.ToString &
Thread.CurrentThread.CurrentCulture.Name.ToString &_& xyzConstants.CONFIG_FILE
to this:
aPath.ExeConfigFilename = strAppPath & "\" & Environment.UserName.ToString &
Thread.CurrentThread.CurrentCulture.Name.ToString & "_" & xyzConstants.CONFIG_FILE

Calculating Data from Separate Workbook VBA

I am trying to put together one main spreadsheet that pulls from over 100 workbooks containing various data. I haven't been able to figure out how to access a closed Workbook in order to calculate the standard deviation from one of the rows.
Sub RefreshSourceData()
Dim sourceFile, fileName As String, path As String
Dim dispersionRange As Range
path = "U:\SPACE Info\Meeting Materials\Strategy Files\"
fileName = "[" & ActiveCell.EntireRow.Cells(1, 1).Value & ".xls]"
sourceFile = "=" & path & fileName
dispersionRange = "=" & path & fileName & "Account'!R:R"
Range("B" & ActiveCell.Row).Formula = sourceFile & "Summary'!$F$2"
Range("C" & ActiveCell.Row).Formula = sourceFile & "Summary'!$F$3"
Range("D" & ActiveCell.Row).Formula = sourceFile & "Summary'!$B$10"
Range("E" & ActiveCell.Row).Formula = sourceFile & "Summary'!$D$10"
Range("F" & ActiveCell.Row).Formula = WorksheetFunction.StDev(dispersionRange)
End Sub
I have received various errors, right now it is "Object Variable or With Object Variable not set."
I have also tried creating a workbook variable consisting of path & filename, but this hasn't worked either.

These are some best effort suggestions, since I can't test everything (I don't have your data).
For your immediate error, I think you intended dispersionRange to be a String, not a Range.
Also, when adding the formula references, make sure you add single quotes around your sourceFile, e.g.:
Range("B" & ActiveCell.Row).Formula = "'" & sourceFile & "Summary'!$F$2"
Range("C" & ActiveCell.Row).Formula = "'" & sourceFile & "Summary'!$F$3"
Range("D" & ActiveCell.Row).Formula = "'" & sourceFile & "Summary'!$B$10"
Range("E" & ActiveCell.Row).Formula = "'" & sourceFile & "Summary'!$D$10"
^^^^^
Similarly for dispersionRange (notice the missing =):
dispersionRange = "'" & path & fileName & "Account'!R:R"
Finally, the last .Formula (for the "F" column) should be .Value, as StDev returns a Double. In addition, the function StDev doesn't take a range as String but a proper Range object, so try this instead:
Range("F" & ActiveCell.Row).Value = WorksheetFunction.StDev(Range(dispersionRange))
UPDATE
To avoid confusion, I've modified your code and I'm listing it below. Please note this is untested, as I don't have access to your workbook, but it should work.
Sub RefreshSourceData()
Dim sourceFile, fileName As String, path As String
Dim dispersionRange As String
path = "U:\SPACE Info\Meeting Materials\Strategy Files\"
fileName = "[" & ActiveCell.EntireRow.Cells(1, 1).Value & ".xls]"
sourceFile = path & fileName
dispersionRange = "'" & path & fileName & "Account'!R:R"
Range("B" & ActiveCell.Row).Formula = "='" & sourceFile & "Summary'!$F$2"
Range("C" & ActiveCell.Row).Formula = "='" & sourceFile & "Summary'!$F$3"
Range("D" & ActiveCell.Row).Formula = "='" & sourceFile & "Summary'!$B$10"
Range("E" & ActiveCell.Row).Formula = "='" & sourceFile & "Summary'!$D$10"
Range("F" & ActiveCell.Row).Value = WorksheetFunction.StDev(Range(dispersionRange))
End Sub

VBA FormulaR1C1 syntax with variable

i'm trying to write formula with 2 variables to cell.
formula in cell should be:
=(SUM('C:\Users\[Excel.xlsm]Sheet1'!H:H)-SUM('C:\Users\[Sheet1.xlsm]Sheet1'!I:I))
i want use path to file as variable, as well sheet name.
path = C:\Users\Excel.xlsm 'from msofiledialog
sheetname = Sheet1
what am i missing ?
Cells(1, 1).FormulaR1C1 = "=(SUM('[" & Path & "] " & sheetname & " '!C8) _
-SUM('[" & Path & "] " & sheetname & " '!C9))

thanks, this worked for me :
Sub main
Dim LastRow as String
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
Dim path as String
Path = "C:\users\username\Desktop\"
Dim filename as String
Filename = "Excel.xlsm"
Dim sheetname as String
sheetnameCR = "CR_" & supname
Dim myrangeH as String
Dim myrangeI as String
myrangeH = ("H5:H" & LastRow)
myrangeI = ("I5:I" & LastRow)
Cells(1, 1).Formula = "=SUM('" & Path & "[" & Filename & "]" & sheetnameCR & "'!" & myrangeH & ")" & "-SUM('" & Path & "[" & Filename & "]" & sheetnameCR & "'!" & myrangeI & ")"
End Sub
i had to add "RangeH" variable, because otherwise excel took cell C8, instead of column H, which i wanted.
that's great, but even after i give him full path to desired cell, excel is still asking me for path to excel with FileDialogOpen. any idea why ?