Excel VBA Help

[excel_learnerz]

Hello all,

I was hoping one of the knowledgeable people here might want to lend some wisdom to help me with my macro

The below macro does work (I am new to VBA so apologies in advance for the bad code, I am sure there are nicer ways to write it)

the macro picks up a value and whichever currency it is it saves a sheet called "quote" to sharepoint in a folder with company name

That's all well and good but in the folder path I have "C:\users\user_1" as part of it. I have SP mapped to my network so the macro works for me since I am user_1 but how can I change this to get it to work for anyone who opens the workbook to generate a quote and not just me, I am not sure how the SP url, I tried but it didn't work or some other way

Thanks in advance


Sub Quote_SP()
Dim FSO
Dim USDFolder As String
Dim EURFolder As String
Dim UKFolder As String
Dim USDPath As String
Dim EURPath As String
Dim UKPath As String

USDPath = "C:\Users\user_1\company\Sales Team - Documents\Quotes\Test_USD"
EURPath = "C:\Users\user_1\company\Sales Team - Documents\Quotes\Test_EUR"
UKPath = "C:\Users\user_1\company\Sales Team - Documents\Quotes\Test_UK"
USDFolder = USDPath & ActiveSheet.Range("B2").Value
EURFolder = EURPath & ActiveSheet.Range("B2").Value
UKFolder = UKPath & ActiveSheet.Range("B2").Value
ChDir "C:\Users\user_1\company\Sales Team - Documents\Quotes"

If ActiveSheet.Range("B3").Value = "$ Dollar" Then
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists(USDFolder) Then
FSO.CreateFolder (USDFolder)
End If

With Sheets("Quote")
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=USDFolder & "" & ActiveSheet.Range("B2").Value & " " & Format(Now, "mmm-dd-yyyy hh-mm") & " " & ActiveSheet.Range("B14").Value & " Quote.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

End With
ElseIf ActiveSheet.Range("B3").Value = "£ Sterling" Then
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists(UKFolder) Then
FSO.CreateFolder (UKFolder)
End If
With Sheets("Quote")
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=UKFolder & "" & ActiveSheet.Range("B2").Value & " " & Format(Now, "mmm-dd-yyyy hh-mm") & " " & ActiveSheet.Range("B14").Value & " Quote.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
ElseIf ActiveSheet.Range("B3").Value = "€ Euro" Then
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not FSO.FolderExists(EURFolder) Then
FSO.CreateFolder (EURFolder)
End If
With Sheets("Quote")
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=EURFolder & "" & ActiveSheet.Range("B2").Value & " " & Format(Now, "mmm-dd-yyyy hh-mm") & " " & ActiveSheet.Range("B14").Value & " Quote.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
End If
End Sub

 

[Tim_Excel_]

Please use

 tags when pasting code.

[CODE][COLOR=#303336][FONT=inherit]Environ[/FONT][/COLOR][COLOR=#303336][FONT=inherit]([/FONT][/COLOR][COLOR=#7D2727][FONT=inherit]"Username"[/FONT][/COLOR][COLOR=#303336][FONT=inherit])[/FONT][/COLOR]

This returns the username of whoever is logged into the Windows machine.

 

[excel_learnerz]

wow cool thanks for that, but in the above where would I put that in?
thanks by the way

(sorry for not using code tags)

 

[Tim_Excel_]

UserName = [COLOR=#303336]Environ[/COLOR][COLOR=#303336]([/COLOR][COLOR=#7D2727]"Username"[/COLOR][COLOR=#303336])[/COLOR]
[COLOR=#333333]ChDir "C:\Users\" & UserName & "\company\Sales Team - Documents\Quotes"[/COLOR]
[COLOR=#333333]USDPath = ChDir & "\Test_USD"[/COLOR]
[COLOR=#333333]EURPath = [/COLOR][COLOR=#333333]ChDir & "[/COLOR][COLOR=#333333]\Quotes\Test_EUR"[/COLOR]
[COLOR=#333333]UKPath = [/COLOR][COLOR=#333333]ChDir & "[/COLOR][COLOR=#333333]\Test_UK"[/COLOR]
[COLOR=#333333]USDFolder = USDPath & ActiveSheet.Range("B2").Value[/COLOR]
[COLOR=#333333]EURFolder = EURPath & ActiveSheet.Range("B2").Value[/COLOR]
[COLOR=#333333]UKFolder = UKPath & ActiveSheet.Range("B2").Value[/COLOR][COLOR=#333333]
[/COLOR]

This would do the trick.

I would recommend not referring to active x's, nor selecting ranges. This is prone to return errors. A safer way:

sht = "Sheet name here"

With Workbooks("NAME")
'...
UKFolder = UKPath & .Sheets(sht).Range("B2").Value
'...
End With

 

[excel_learnerz]

thank you so much

 

[Tim_Excel_]

Glad I could help you