VBA What is the Univerisal Short File Path to Documents Folder? (1 Viewer)

V

Vagus14

Registered User.
Local time
Today, 08:04
Joined
May 19, 2014
Messages
66
I have the code below and I want it to open a file from my documents folder. The only problem is that every computers path is different to this folder. Does anyone know an easy way to work around and open a file in My Documents without the full path?

I want to eliminate the part of the path in red and make it universal because computers will have a different number.

Operating System: Windows 7

Code below:

Code: 
Public Function AddITARPicOffloadAnalysis()
    Dim xlApp As Object
    Set xlApp = CreateObject("Excel.Application")
    With xlApp
    Dim wb As Object
    Dim ws As Object
    Dim Lastrow As Long
    
On Error Resume Next
[COLOR=seagreen]Set wb = .Workbooks.Open[/COLOR][COLOR=seagreen]("[COLOR=red]C:\Users\f0000\[/COLOR]Documents\Sample.xlsx")
[/COLOR]Set ws = wb.Sheets(1)
'Code below counts the cells with data and selects the last empty cell
Lastrow = ws.UsedRange.Rows.Count
Blankcell = Lastrow + 1
ws.Cells(Blankcell, "I").Select
ws.pictures.insert ("D:\sample.png")
xlApp.Visible = True
LinkToFile = False
SaveWithDocument = True
'ws.SaveAs FileName:="D:\" & BookName
wb.Close , SaveChanges:=True
Set xlApp = Nothing
End With
End Function
 
N

namliam

The Mailman - AWF VIP
Local time
Today, 14:04
Joined
Aug 11, 2003
Messages
11,695
LMGTFY

One of the first links I found:
Code: 
Function GetSpecialFolderNames()
Dim objFolders As Object
Set objFolders = CreateObject("WScript.Shell").SpecialFolders

MsgBox objFolders("desktop")
MsgBox objFolders("allusersdesktop")
MsgBox objFolders("sendto")
MsgBox objFolders("startmenu")
MsgBox objFolders("recent")
MsgBox objFolders("favorites")
MsgBox objFolders("mydocuments")
End Function
 
pr2-eugin

pr2-eugin

Super Moderator
Local time
Today, 13:04
Joined
Nov 30, 2011
Messages
8,494
I normally use Environ("userprofile"), but the above code is much better, adding it my code library ! Thanks namliam. :)
 
V

Vagus14

Registered User.
Local time
Today, 08:04
Joined
May 19, 2014
Messages
66
Awesome, thanks. I will give this a try now in my code. Much appreciated.
 
V

Vagus14

Registered User.
Local time
Today, 08:04
Joined
May 19, 2014
Messages
66
Ok I'm trying to put this in but I'm having an issue. I still want to bind the wb in at the same time. Anyone have a solution?

Set wb = .Workbooks.Open objFolders("mydocuments\OffloadAnalysis.xlsx") 'Complie Error here

Code: 
Public Function AddITARPicOffloadAnalysis()
    Dim xlApp As Object
    Set xlApp = CreateObject("Excel.Application")
    With xlApp
    Dim wb As Object
    Dim ws As Object
    Dim Lastrow As Long
    Dim objFolders As Object
    Set objFolders = CreateObject("WScript.Shell").SpecialFolders
    'MsgBox objFolders("mydocuments\OffloadAnalysis.xlsx")
'On Error Resume Next
Set wb = .Workbooks.Open objFolders("mydocuments\OffloadAnalysis.xlsx") 'Complie Error here
Set ws = wb.Sheets(1)
'Code below counts the cells with data and selects the last empty cell
Lastrow = ws.UsedRange.Rows.Count
Blankcell = Lastrow + 1
ws.Cells(Blankcell, "I").Select
ws.pictures.insert ("D:\sample.png")
xlApp.Visible = True
LinkToFile = False
SaveWithDocument = True
wb.Close , SaveChanges:=True
Set xlApp = Nothing
End With
End Function
 
pr2-eugin

pr2-eugin

Super Moderator
Local time
Today, 13:04
Joined
Nov 30, 2011
Messages
8,494
Try this,
Code: 
Public Function AddITARPicOffloadAnalysis()
    Dim xlApp As Object
    Dim wb As Object
    Dim ws As Object
    Dim Lastrow As Long
    Dim objFolders As Object
    
    Set xlApp = CreateObject("Excel.Application")
    With xlApp
        Set objFolders = CreateObject("WScript.Shell").SpecialFolders
        Set wb = .Workbooks.Open[COLOR=Red][B]([/B][/COLOR]objFolders("mydocuments") & "\OffloadAnalysis.xlsx"[COLOR=Red][B])[/B][/COLOR]
        Set ws = wb.Sheets(1)
        'Code below counts the cells with data and selects the last empty cell
        Lastrow = ws.UsedRange.Rows.Count
        Blankcell = Lastrow + 1
        ws.Cells(Blankcell, "I").Select
        ws.pictures.insert ("D:\sample.png")
        .Visible = True
        LinkToFile = False
        SaveWithDocument = True
        wb.Close , SaveChanges:=True
    End With
    Set xlApp = Nothing
End Function
 
Last edited:
N

namliam

The Mailman - AWF VIP
Local time
Today, 14:04
Joined
Aug 11, 2003
Messages
11,695
Set wb = .Workbooks.Open objFolders("mydocuments") & "\OffloadAnalysis.xlsx"

:banghead:
 
Last edited:
V

Vagus14

Registered User.
Local time
Today, 08:04
Joined
May 19, 2014
Messages
66
Hmm still not working. It wants objFolders seperate, but if I do that I can't bind.
 
pr2-eugin

pr2-eugin

Super Moderator
Local time
Today, 13:04
Joined
Nov 30, 2011
Messages
8,494
Check the edited code in Post#6 ! I used parentheses around the Open method !
 
V

Vagus14

Registered User.
Local time
Today, 08:04
Joined
May 19, 2014
Messages
66
Got it.

Set wb = .Workbooks.Open(objFolders("mydocuments") & "\OffloadAnalysis.xlsx")

Thanks for all your help.
 
You must log in or register to reply here.

Similar threads

R
Updating Excel spreadsheet from within the Access
Replies
8
Views
339
CJ_London
C
T
Solved Append table to excel file
Replies
8
Views
812
ebs17
E
MattBaldry
Solved Open Set Folder to Select File
Replies
3
Views
428
theDBguy
theDBguy
R
Solved change folder path with varible
Replies
18
Views
675
rainbows
R
C
Solved i want to change this code to merge two excel files to one sheet side by side.
Replies
2
Views
216
camiramzi
C

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Top Bottom