PDA

View Full Version : Solved: Path to macro



ioncila
03-25-2009, 09:05 AM
Hi

I´m diving in a new challenge

I have a macro that calls 3 different workbooks, all in the same folder. I run it from a pendrive, while I´m at home computer or in work place. The problem is that the path to macro appears different in each computer because they call different names to my pendrive:

At home
...\G:\...\Folder\...\Workbook
At work
...\H:\...\Folder\...\Workbook

So I need to change code everytime I change my work place (its idiot i know).

Is there a way to make both computers (or any other computer) recognize the right path automatically?

Thank you all

lucas
03-25-2009, 09:15 AM
That would be pretty difficult I think but you can browse for the location:
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
If .Show = -1 Then
MsgBox .SelectedItems(1)
End If
End With

mdmackillop
03-25-2009, 09:39 AM
This will show available Environ data. You could test for a suitable value and use that to set your path

Sub Details()
Dim i
For i = 1 To 50
Cells(i, 1) = Environ(i)
Next
End Sub

Kenneth Hobs
03-25-2009, 09:41 AM
ThisWorkbook.Path is generally a good way around those issues.

Add code to check for the Drive:\Path using DIR(yourdrive:\path, vbDirectory). e.g.
Sub Test_PathIs()
Dim myPath As String, tPaths As String
tPaths = "e:\Excel\,xx:\,e:\MyFiles\Excel\,t:\,z:\MyFiles\Excel\"
myPath = PathIs(tPaths)
If myPath = "NA" Then
MsgBox "No path exists for: " & vbCrLf & tPaths, vbCritical, "Eror"
Exit Sub
End If
MsgBox myPath, vbInformation, "Found a Path"
End Sub

Function PathIs(tryPaths As String) As String
Dim a, e
a = Split(tryPaths, ",")
For Each e In a
On Error GoTo NextE
If Dir(e, vbDirectory) <> vbNullString Then
PathIs = e
Exit Function
End If
NextE:
Next e
PathIs = "NA"
End Function

ioncila
03-29-2009, 04:36 AM
Hi

I tried all suggestions but it seems something is wrong.

The original piece of code is:

Workbooks.Open Filename:="H:\PASTA TÉCNICA Experiment\AAA REG Propostas.xls"

"H" is pendrive attribute from work desktop.

I need to rename it automatically to "G" when I'm home or to another atribute when i open from any other computer.

Certainly this is very simple but I'm experiencing some dificult to understand the suggestions. So a little more help would be welcome.

Thank you guys

mdmackillop
03-29-2009, 04:51 AM
'Get computer name
Sub ComputerName()
MsgBox Environ(5)
End Sub

'Add correct names to code
Sub PenDrive()
Select Case Environ(5)
Case "HomePC"
drv = "G:\"
Case "Office"
drv = "H:\"
Case "xyz"
drv = "F:\"
End Select
Workbooks.Open Filename:=drv & "PASTA TÉCNICA Experiment\AAA REG Propostas.xls"
End Sub

mdmackillop
03-29-2009, 05:00 AM
An alternative

Sub PenDrive2()
Dim fs, d, dc
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
For Each d In dc
fname = d & "\PASTA TÉCNICA Experiment\AAA REG Propostas.xls"
If Len(Dir(fname)) > 0 Then
Workbooks.Open (fname)
Exit For
End If
Next
End Sub

ioncila
03-29-2009, 05:22 AM
hi mdmackillop
Thank you for your fast replies. I tried both but seems to have some issues to resolve.

Here is the 2nd alternative in my code (sorry for the complexity but I'm newbie in VBA and I know I have a lot to learn to make it simplier).

Note that there are two files I need to open

Sub ComputerName()
MsgBox Environ(5)
End Sub
Sub PenDrive2()
Dim fs, d, dc
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
For Each d In dc
fname = d & "\PASTA TÉCNICA Experiment\AAA REG Propostas.xls"
If Len(Dir(fname)) > 0 Then
Workbooks.Open (fname)
Exit For
End If
Next
End Sub
Sub MacroFecho(Optional MacroVisible As Boolean)

msg = "Limpar Dados e Recalcular?"
If MsgBox(msg, vbQuestion + vbYesNo, "ATENÇÃO") = vbNo Then
Exit Sub
End If

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

'LIMPEZA DAS FOLHAS DE CÁLCULO(Worksheets)
ThisWorkbook.Worksheets("Calc FECHO").Range("M21:AG21").ClearContents 'Campo "Entidade"
ThisWorkbook.Worksheets("Calc FECHO").Range("M24:AG24").ClearContents 'Campo "Empreitada"
ThisWorkbook.Worksheets("Calc FECHO").Range("P29:T29").ClearContents 'Campo "Valor Base"
ThisWorkbook.Worksheets("Calc FECHO").Range("AF29:AG29").ClearContents 'Campo "Custo do Processo"
ThisWorkbook.Worksheets("Calc FECHO").Range("P31:T31").ClearContents 'Campo "Data do Anúncio DR"
ThisWorkbook.Worksheets("Calc FECHO").Range("AB31:AC31").ClearContents 'Campo "Prazo de Execução"
ThisWorkbook.Worksheets("Calc FECHO").Range("P33:T33").ClearContents 'Campos "Data/Hora de Entrega da Proposta"
ThisWorkbook.Worksheets("Calc FECHO").Range("AB33:AG33").ClearContents 'Campos "Crit Aval Preço/TÉCNICO/PRAZO"
ThisWorkbook.Worksheets("Calc FECHO").Range("AC35:AD35").ClearContents 'Campo "Variante VAR"
ThisWorkbook.Worksheets("Calc FECHO").Range("AF35:AG35").ClearContents 'Campo "Condicionada CND"
ThisWorkbook.Worksheets("Calc FECHO").Range("M42:N42").ClearContents 'Campo "Pç ACTUAL Gasóleo LT"
ThisWorkbook.Worksheets("Calc FECHO").Range("S42:T42").ClearContents 'Campo "Custo QUILÓMETRO KM"
ThisWorkbook.Worksheets("Calc FECHO").Range("M44:N44").ClearContents 'Campo "Comprimento Vala ML"
ThisWorkbook.Worksheets("Calc FECHO").Range("AE44:AF44").ClearContents 'Campo "Comprimento Tubagem ML"
ThisWorkbook.Worksheets("Calc FECHO").Range("P117:Q141").ClearContents 'Campos de Valor Diário - Recursos Pessoal Estaleiro
ThisWorkbook.Worksheets("Calc FECHO").Range("P196:Q208").ClearContents 'Campos de Encargos Logística
ThisWorkbook.Worksheets("Calc FECHO").Range("P231:Q247").ClearContents 'Campos Valor Diário - Recursos Pessoal Frentes Obra
ThisWorkbook.Worksheets("Calc FECHO").Range("P282:Q364").ClearContents 'Campos Valor Diário - Equipamento

'IMPORTAR DADOS DE WB(AAA REG Propostas.xls).WS(REGconcursos)

'Workbooks.Open Filename:= "H:\PASTA TÉCNICA Experiment\AAA REG Propostas.xls"

Dim Origem As Worksheet
Dim Destino As Worksheet
Set Destino = ThisWorkbook.Worksheets("Calc FECHO")
Set Origem = Workbooks("AAA REG Propostas.xls").Worksheets("REGconcursos")

num_proposta = Destino.Cells(21, 9).Value

num_linhas = 0

Do
num_linhas = num_linhas + 1
Loop While Origem.Cells(num_linhas + 1, 1).Value <> ""

For Each rw In Origem.Cells(16, 1).CurrentRegion.Rows
num_linhas = num_linhas + 1
Next

For rw = 16 To num_linhas

If num_proposta = Origem.Cells(rw, 1).Value Then
'Importar nome ENTIDADE
Destino.Cells(21, 13).Value = Origem.Cells(rw, 4).Value
'Importar nome EMPREITADA
Destino.Cells(24, 13).Value = Origem.Cells(rw, 5).Value
'Importar VALOR BASE
Destino.Cells(29, 16).Value = Origem.Cells(rw, 6).Value
'Importar CUSTO PROCESSO
Destino.Cells(29, 32).Value = Origem.Cells(rw, 22).Value
'Importar DATA ANÚNCIO DR
Destino.Cells(31, 16).Value = Origem.Cells(rw, 9).Value
'Importar PRAZO EXECUÇÃO BASE
Destino.Cells(31, 28).Value = Origem.Cells(rw, 7).Value & " " & Origem.Cells(rw, 8).Value
'Importar DATA ENTREGA
Destino.Cells(33, 16).Value = Origem.Cells(rw, 12).Value
'Importar HORA ENTREGA
Destino.Cells(33, 19).Value = Origem.Cells(rw, 13).Value
'Importar CRITÉRIO PREÇO
Destino.Cells(33, 28).Value = Origem.Cells(rw, 19).Value
'Importar CRITÉRIO TÉCNICO
Destino.Cells(33, 30).Value = Origem.Cells(rw, 20).Value
'Importar CRITÉRIO PRAZO
Destino.Cells(33, 32).Value = Origem.Cells(rw, 21).Value
'Importar VARIANTES
Destino.Cells(35, 29).Value = Origem.Cells(rw, 17).Value
'Importar CONDICIONADA
Destino.Cells(35, 32).Value = Origem.Cells(rw, 18).Value
'Importar preço DIESEL
Destino.Cells(42, 13).Value = Origem.Cells(rw, 28).Value
'Importar preço QUILÓMETROS
Destino.Cells(42, 19).Value = Origem.Cells(rw, 29).Value
'Importar COMPRIMENTO VALA
Destino.Cells(44, 13).Value = Origem.Cells(rw, 44).Value
'Importar COMPRIMENTO TUBAGEM
Destino.Cells(44, 31).Value = Origem.Cells(rw, 45).Value
'Importar Preço ALUGUER TERRENO ESTALEIRO
Destino.Cells(196, 16).Value = Origem.Cells(rw, 57).Value
'Importar Preço REFEIÇÕES ALMOÇO
Destino.Cells(198, 16).Value = Origem.Cells(rw, 55).Value
'Importar Preço REFEIÇÕES JANTAR
Destino.Cells(200, 16).Value = Origem.Cells(rw, 56).Value
'Importar Preço ALOJAMENTO
Destino.Cells(202, 16).Value = Origem.Cells(rw, 58).Value
'Importar Valor SUBS DESLOCAÇÃO DIÁRIO
Destino.Cells(204, 16).Value = Origem.Cells(rw, 59).Value
'Importar DISTÂNCIA QUILÓMETROS
Destino.Cells(206, 16).Value = Origem.Cells(rw, 26).Value
'Importar DISTÂNCIA PORTAGENS
Destino.Cells(208, 16).Value = Origem.Cells(rw, 27).Value

End If

Next rw

Workbooks("AAA REG Propostas.xls").Close SaveChanges:=False

'IMPORTAR DADOS DE WB(AAA CALC Orc.xls).WS(Calc MOBRA)

'Workbooks.Open Filename:="H:\PASTA TÉCNICA Experiment\AAA CALC Orc.xls"

Dim Origem01 As Worksheet
Dim Origem02 As Worksheet
Dim Destino01 As Worksheet
Set Origem01 = Workbooks("AAA CALC Orc.xls").Worksheets("Calc MOBRA")
Set Origem02 = Workbooks("AAA CALC Orc.xls").Worksheets("INDICEequipam")
Set Destino01 = ThisWorkbook.Worksheets("Calc FECHO")

'Recursos PESSOAL ADSTRITO AO ESTALEIRO

k = 117

For i = 11 To 300

If Origem01.Cells(i, 2).Value > 0 And Origem01.Cells(i, 9).Value > 0 And Destino01.Cells(k, 8).Value > 0 And Destino01.Cells(k, 8).Value = Origem01.Cells(i, 2).Value Then

Destino01.Cells(k, 16).Value = Origem01.Cells(i, 9).Value

k = k + 2

End If

Next i

'Recursos PESSOAL ADSTRITO AO ESTALEIRO

k = 231

For i = 11 To 300


If Origem01.Cells(i, 2).Value > 0 And Origem01.Cells(i, 9).Value > 0 And Destino01.Cells(k, 8).Value > 0 And Destino01.Cells(k, 8).Value = Origem01.Cells(i, 2).Value Then

Destino01.Cells(k, 16).Value = Origem01.Cells(i, 9).Value

k = k + 2

End If

Next i

'Recursos EQUIPAMENTO ADSTRITO AO ESTALEIRO E FRENTES DE OBRA

k = 282

For i = 6 To 300

If Origem02.Cells(i, 2).Value > 0 And Origem02.Cells(i, 6).Value > 0 And Destino01.Cells(k, 8).Value > 0 And Destino01.Cells(k, 8).Value = Origem02.Cells(i, 2).Value Then

Destino01.Cells(k, 16).Value = Origem02.Cells(i, 6).Value
Destino01.Cells(k, 7).Value = Origem02.Cells(i, 8).Value

k = k + 2

End If

Next i


Workbooks("AAA CALC Orc.xls").Close SaveChanges:=False

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox "Introdução de Dados Concluída"

End Sub

mdmackillop
03-29-2009, 06:04 AM
I don't have time to go all through this, but I've amended the first part of the code. You will see three variables. Use these to qualify each Sheet or Range etc. in your code. Note that Propostas and CalcOrg are declared before the code. This allows them to be used in both sub routines.
Note also that PenDrive is called by MacroFecho; it is not run by the user.


Dim Propstas As Workbook
Dim CalcOrg As Workbook

Sub PenDrive2()
Dim fs, d, dc
Set fs = CreateObject("Scripting.FileSystemObject")
Set dc = fs.Drives
For Each d In dc
fname1 = d & "\PASTA TÉCNICA Experiment\AAA REG Propostas.xls"
fname2 = d & "\PASTA TÉCNICA Experiment\AAA CALC Orc.xls"
If Len(Dir(fname1)) > 0 Then
Set Propstas = Workbooks.Open(fname1)
Set CalcOrg = Workbooks.Open(fname2)
Exit For
End If
Next
End Sub


Sub MacroFecho(Optional MacroVisible As Boolean)
Dim ThsBook As Workbook

'Set reference to active book
Set ThsBook = ActiveWorkbook
'Open other workbookas and set references to same (Propostas & CalcOrg)
PenDrive2
'Return to original workbook
ThsBook.Activate
msg = "Limpar Dados e Recalcular?"
If MsgBox(msg, vbQuestion + vbYesNo, "ATENÇÃO") = vbNo Then
Exit Sub
End If
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Use references to keep clear where your ranges etc. are
'LIMPEZA DAS FOLHAS DE CÁLCULO(Worksheets)
With ThsBook
.Worksheets("Calc FECHO").Range("M21:AG21").ClearContents 'Campo "Entidade"
.Worksheets("Calc FECHO").Range("M24:AG24").ClearContents 'Campo "Empreitada"
.Worksheets("Calc FECHO").Range("P29:T29").ClearContents 'Campo "Valor Base"
.Worksheets("Calc FECHO").Range("AF29:AG29").ClearContents 'Campo "Custo do Processo"
.Worksheets("Calc FECHO").Range("P31:T31").ClearContents 'Campo "Data do Anúncio DR"
.Worksheets("Calc FECHO").Range("AB31:AC31").ClearContents 'Campo "Prazo de Execução"
.Worksheets("Calc FECHO").Range("P33:T33").ClearContents 'Campos "Data/Hora de Entrega da Proposta"
.Worksheets("Calc FECHO").Range("AB33:AG33").ClearContents 'Campos "Crit Aval Preço/TÉCNICO/PRAZO"
.Worksheets("Calc FECHO").Range("AC35:AD35").ClearContents 'Campo "Variante VAR"
.Worksheets("Calc FECHO").Range("AF35:AG35").ClearContents 'Campo "Condicionada CND"
.Worksheets("Calc FECHO").Range("M42:N42").ClearContents 'Campo "Pç ACTUAL Gasóleo LT"
.Worksheets("Calc FECHO").Range("S42:T42").ClearContents 'Campo "Custo QUILÓMETRO KM"
.Worksheets("Calc FECHO").Range("M44:N44").ClearContents 'Campo "Comprimento Vala ML"
.Worksheets("Calc FECHO").Range("AE44:AF44").ClearContents 'Campo "Comprimento Tubagem ML"
.Worksheets("Calc FECHO").Range("P117:Q141").ClearContents 'Campos de Valor Diário - Recursos Pessoal Estaleiro
.Worksheets("Calc FECHO").Range("P196:Q208").ClearContents 'Campos de Encargos Logística
.Worksheets("Calc FECHO").Range("P231:Q247").ClearContents 'Campos Valor Diário - Recursos Pessoal Frentes Obra
.Worksheets("Calc FECHO").Range("P282:Q364").ClearContents 'Campos Valor Diário - Equipamento
End With

'IMPORTAR DADOS DE WB(AAA REG Propostas.xls).WS(REGconcursos)
'Workbooks.Open Filename:= "H:\PASTA TÉCNICA Experiment\AAA REG Propostas.xls"
Dim Origem As Worksheet
Dim Destino As Worksheet
Set Destino = ThsBook.Worksheets("Calc FECHO")
Set Origem = Propostas.Worksheets("REGconcursos")
num_proposta = Destino.Cells(21, 9).Value
num_linhas = 0
Do
num_linhas = num_linhas + 1
Loop While Origem.Cells(num_linhas + 1, 1).Value <> ""
For Each rw In Origem.Cells(16, 1).CurrentRegion.Rows
num_linhas = num_linhas + 1
Next

ioncila
03-29-2009, 06:53 AM
@mdmackillop

Man, you did much much more than i expected. Thank you very much for that. By putting here all code I didnt mean you to correct it, just to understand what I was doing. Thank you very much for the improvements you have made.

However, there is an issue in this line (Sub Pendrive2):

If Len(Dir(fname1)) > 0 Then - a msg appears saying "bad file name or number".

When I put the cursor over the code line, the highlight shows path "A:\PASTA TÉCNICA Experiment\AAA REG Propostas.xls".

Have you a solution?

mdmackillop
03-29-2009, 06:57 AM
Looks like a Floppy Drive issue. We can skip over it

For Each d In dc
If d <> "a:" Then
fname1 = d & "\PASTA TÉCNICA Experiment\AAA REG Propostas.xls"
fname2 = d & "\PASTA TÉCNICA Experiment\AAA CALC Orc.xls"
If Len(Dir(fname1)) > 0 Then
Set Propstas = Workbooks.Open(fname1)
Set CalcOrg = Workbooks.Open(fname2)
Exit For
End If
End If
Next

ioncila
03-29-2009, 07:54 AM
@mdmackillop

Man, you did much much more than i expected. Thank you very much for that. By putting here all code I didnt mean you to correct it, just to understand what I was doing. Thank you very much for the improvements you have made.

However, there is an issue in this line (Sub Pendrive2):

If Len(Dir(fname1)) > 0 Then - a msg appears saying "bad file name or number".

When I put the cursor over the code line, the highlight shows path "A:\PASTA TÉCNICA Experiment\AAA REG Propostas.xls".

Have you a solution?

ioncila
03-29-2009, 08:49 AM
Sorry for insistance but the issue is still there, with the same msg

mdmackillop
03-29-2009, 09:06 AM
Did you see my post 11?

ioncila
03-29-2009, 09:45 AM
Did you see my post 11?

Yes. You create skip for "A" drive, but still dont work.
It returns same error on same line, and the highlight over the line code still shows "A" drive

mdmackillop
03-30-2009, 01:39 PM
I can't replicate this on my PC. Anyone else help?

GTO
03-30-2009, 07:56 PM
...
At home
...\G:\...\Folder\...\Workbook
At work
...\H:\...\Folder\...\Workbook
...

Greetings to all,

Hopefully I'm not off track, but it looked to me as if we can count on the pendrive coming back (being recognized) as one of two drives. Now if we are assured that there is no G:\ drive at work and no H:\ drive at home, I was thinking this might work?

Private Function PenDrive2(WBName As String) As Workbook
Dim fso As Object 'FileSystemObject

Const PATH_WB As String = "\PASTA TÉCNICA Experiment\"

Set fso = CreateObject("Scripting.FileSystemObject")

If fso.DriveExists("G") Then
On Error Resume Next
Set PenDrive2 = Workbooks.Open("G:\" & PATH_WB & WBName)
On Error GoTo 0
ElseIf fso.DriveExists("H") Then
On Error Resume Next
Set PenDrive2 = Workbooks.Open("H:\" & PATH_WB & WBName)
On Error GoTo 0
Else
Set PenDrive2 = Nothing
End If
End Function

Then the first few lines of as shown by Malcom at #9:
Sub MacroFecho(Optional MacroVisible As Boolean)
Dim ThsBook As Workbook

'Set reference to active book
Set ThsBook = ActiveWorkbook

'Open other workbookas and set references to same (Propostas & CalcOrg)
Set Propstas = PenDrive2("AAA REG Propostas.xls")
Set CalcOrg = PenDrive2("AAA CALC Orc.xls")

If Propstas Is Nothing _
Or CalcOrg Is Nothing Then
MsgBox "We have a problem Houston...", 0, vbNullString
Exit Sub
End If
'PenDrive2

'Return to original workbook
ThsBook.Activate
'...remaining statements...

Does this help?

@mdmackillop:
Hi Malcom,

I was able to replicate error at work; certain network drives and the cd drive would toss <Bad file name or number> in a Watch. I couldn't figure why though, as while the removable media (floppy or cd) would make sense, I couldn't figure why certain network drives gacked. (It wasn't due to lacking access rights.)

Mark

mdmackillop
03-31-2009, 01:18 AM
Hi Mark,
I used "A:" in my code, does it work with "A"?

GTO
03-31-2009, 04:32 AM
@mdmackillop:
Hey Brother,

Well... you'll have to (or properly, "I hope you'll...") forgive me; long day etc, so hope to make up for my lacking in previous, but this may be a bit scattered/windy...

I probably (unintentionally) inferred that I had tested against diskette drive (A: ), I had not. Simply surmised that this would test same as CD drive, being removable media. (At work, newer PCs don't have A:, but do have D: {CD})

Anyways, I had tested (stepped thru until PenDrive2 done) yours from #9 (w/#11 update). As mentioned, failed on certain network drives, as well as removable media drive.

Okay - at home now, so re-created in 2000 on ye olde laptop (generally described as "electric" and that's about it...). Said LP has both insertable A:\ and D:\ (CD), tested against both.

Son-of-a-Buck! Here's something I wouldn't have thought of. It appears fso.Drives returns a case-sensitive string! Checking for "a:" or "A" fail, but checking for "A:" caught it. (Dangit, I just re-read your question. Would'a been wittier to say, "no ya didn't..")

Well, a long winded answer, but better effort this time.

Say, what did you think about checking the existence? I was thinking it would skip looping thru and catch missing file/drive (still might go KABOOM! if "opposite" drive exists). Did you catch any "goofy" places in my logic?

A great day to your and yours,

Mark

ioncila
03-31-2009, 05:12 AM
Hi guys

I tried GTO suggestions and works perfectly at home. I will be at work in 2 hours and I will try it in work desktop and laptop. I will inform later.

Thank you all very much

ioncila
03-31-2009, 07:12 AM
Ok I'm at work

And here, there is an issue:

When I run "macroFECHO" (that needs to open the two files), is gets the GTO's message "there is a problem Houston"

Here at work pendrive would be recognized as "H:"

At home, the pendrive is recognized by "G:" and it worked fine (as I said in first post, I used to have to to change code to G: for I could open it at home).

GTO
03-31-2009, 12:35 PM
Greetings,

Well shucks, I included H:\ as you no doubt see, so am curious as to what's happening. Does the pendrive show as H:\...\ on both the laptop and PC at work?

Lacking a better thought, in a new throwaway workbook, try this (at work). You can either copy the info from the msgbox, or just click View|Immediate Window in VBIDE and copy the info from there. Maybe this will show us what the problem is with H:. If not, no harm as nothing is set.

Mark
Option Explicit

Sub Drives_Ret()
Dim fso As Object 'FileSystemObject
Dim f_drives As Object 'Drives
Dim f_drive As Object 'Drive
Dim strTMP As String
Dim strBuild As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set f_drives = fso.Drives

For Each f_drive In f_drives
If Not f_drive.DriveType = 0 _
And Not f_drive.DriveType = 1 _
And Not f_drive.DriveType = 3 _
And Not f_drive.DriveType = 5 Then
strTMP = Chr(39) & f_drive.RootFolder & Chr(39) & vbTab & _
DriveType_Ret(fso, f_drive.DriveLetter)
Else
strTMP = Chr(39) & f_drive.DriveLetter & ":" & Chr(39) & vbTab & _
DriveType_Ret(fso, f_drive.DriveLetter)
End If

strBuild = strBuild & strTMP & vbCrLf
Next

strBuild = Left(strBuild, Len(strBuild) - 2)
MsgBox strBuild
Debug.Print strBuild
End Sub

Function DriveType_Ret(fs As Object, drive_path As String) As String
Dim fs_drive As Object 'Drive

Set fs_drive = fs.GetDrive(drive_path)

Select Case fs_drive.DriveType
Case 0: DriveType_Ret = "Unknown"
Case 1: DriveType_Ret = "Removable"
Case 2: DriveType_Ret = "Fixed"
Case 3: DriveType_Ret = "Network"
Case 4: DriveType_Ret = "CD-ROM"
Case 5: DriveType_Ret = "RAM Disk"
End Select
End Function

(Note: I didn't look for Root for unk/ram/ or network, as am at home and wasn't sure of poss errors...)

Kenneth Hobs
03-31-2009, 01:10 PM
Did my method not work for you? Here it is again tailored a bit more for simplicity.

Sub Test()
OpenMyWB
End Sub
Sub OpenMyWB()
Dim myPath As String, tPaths As String
tPaths = "H:\PASTA TÉCNICA Experiment\AAA REG Propostas.xls," & _
"G:\PASTA TÉCNICA Experiment\AAA REG Propostas.xls"
myPath = PathIs(tPaths)
If myPath = "NA" Then
MsgBox "No path exists for: " & vbCrLf & tPaths, vbCritical, "Eror"
Exit Sub
End If
Workbooks.Open Filename:=myPath
End Sub

Function PathIs(tryPaths As String) As String
Dim a, e
a = Split(tryPaths, ",")
For Each e In a
On Error GoTo NextE
If Dir(e, vbDirectory) <> vbNullString Then
PathIs = e
Exit Function
End If
NextE:
Next e
PathIs = "NA"
End Function

ioncila
03-31-2009, 03:01 PM
Hi guys

I tried both suggestions from GTO and Kenneth at home desktop scenario (Excel2003) (Pendrive recognized by G:\) and here the results.

@GTO
It retuns an error "Path not found" and highlights these code lines:
strTMP = Chr(39) & f_drive.RootFolder & Chr(39) & vbTab & _
DriveType_Ret(fso, f_drive.DriveLetter)

@Kenneth
It works fine as it opens the file.
Sorry if I didnt reply directly to your first attempt but it also gaves an error.

At laptop scenario (Excel2007) (pendrive recognized by D:\)

@GTO
Running your code it returns a msg box with the followed information:
'C:\' Fixed; 'D:' Removable; 'E:' Fixed; 'F:\' CD Rom

@Kenneth
Running your code it returns a msg box "No path exists. H:\...."

For work desktop (Excel2003) (pendrive recognized by H:\) we have to wait till tomorrow - 23:00 now here.

Hope that these informations can help you.

Once again thank you very much

GTO
04-01-2009, 12:28 AM
Hi ioncila,

Sorry 'bout that, lets simplify the test a bit before you try it at work, so that it doesn't error. (The function 'DriveType_Ret' stays the same.)


Sub Drives_Ret()
Dim fso As FileSystemObject
Dim f_drives As Drives
Dim f_drive As Drive
Dim strTMP As String
Dim strBuild As String
Set fso = CreateObject("Scripting.FileSystemObject")
Set f_drives = fso.Drives

For Each f_drive In f_drives
'// for our temp testing, we'll change to only checking RootFolder if
'// fixed to elimainate errors. Sorry 'bout that.
If f_drive.DriveType = 2 Then

strTMP = Chr(39) & f_drive.RootFolder & Chr(39) & vbTab & _
DriveType_Ret(fso, f_drive.DriveLetter)
Else
strTMP = Chr(39) & f_drive.DriveLetter & ":" & Chr(39) & vbTab & _
DriveType_Ret(fso, f_drive.DriveLetter)
End If

strBuild = strBuild & strTMP & vbCrLf
Next

strBuild = Left(strBuild, Len(strBuild) - 2)
MsgBox strBuild
Debug.Print strBuild

End Sub

I am still curious as to why it didn't work (find H: ) at work, so maybe the simpler test will return some info...

Also - I tested Kenneth's at work, as I happen to have an H: (network) and flashdrive shows as G:, so created the folder and file. Worked great in either location!

Now I am curious as to a couple of things, as you mentioned also testing it in a laptop at home, where the pendrive shows as D:\

Are you actually wanting it to look for more than H: or G: , such as if you use your home laptop, it should find the folder under D:\ ?

And probably a daffy question, but you keep mentioning running the macro with the pendrive in different machines. REference the workbook that has these macros ['Sub MacroFecho(Optional MacroVisible As Boolean)' etc], where is this workbook stored? By chance, is it in the pendrive as well?

Thanks,

Mark

ioncila
04-01-2009, 09:44 AM
Hi ioncila,

Sorry 'bout that, lets simplify the test a bit before you try it at work, so that it doesn't error. (The function 'DriveType_Ret' stays the same.)


Sub Drives_Ret()
Dim fso As FileSystemObject
Dim f_drives As Drives
Dim f_drive As Drive...


End Sub
I am still curious as to why it didn't work (find H: ) at work, so maybe the simpler test will return some info...

Also - I tested Kenneth's at work, as I happen to have an H: (network) and flashdrive shows as G:, so created the folder and file. Worked great in either location!

Now I am curious as to a couple of things, as you mentioned also testing it in a laptop at home, where the pendrive shows as D:\

Are you actually wanting it to look for more than H: or G: , such as if you use your home laptop, it should find the folder under D:\ ?

And probably a daffy question, but you keep mentioning running the macro with the pendrive in different machines. REference the workbook that has these macros ['Sub MacroFecho(Optional MacroVisible As Boolean)' etc], where is this workbook stored? By chance, is it in the pendrive as well?

Thanks,

Mark

Hi Mark

I tested at work desktop the changes you've made and doesnt work: msg"User defined type not defined".
If I alternate 'Drives' to 'Object' as you showed in first code, it returns a msgbox with the case drives

Code from Kenneth works perfect and opens the file.

so in conclusion: Kenneth's is fine at home and work destops but fails al laptop.

Answering to your question:

Most of my job projects I need to keep on working at home or on the 'outside'. This workbook that is stored in pendrive (flashdrive) has some macros I call from other files located in desktops and laptop. Thats why I need the pendrive to be auto recognized without changing the code

Kenneth Hobs
04-01-2009, 10:16 AM
Please do not quote unless you need to quote parts.

To use the method that mdmackillop posted (#6), you need to know and modify the computername for your home and work pc's in the Case lines. Add other cases such as one for your laptop. You can type in VBE's Immediate window and press enter to see your names:
?Environ("computername")

Or: Ctrl+R > %computername% > OK

I would also change mdmackillop's post's #6 Environ(5) to Environ("computername") as well.

Keep in mind that if Explorer can not see your pen drives, Excel won't either. I have found that it takes two tries to view the drives to make them active sometimes.

I doubt that my method fails. Displaying a message that it could not find a file means that it worked for that scenario. As above, maybe a retry would then find the file? I would have to tinker a bit to see if a retry in the code would help for the drive isready issue.

Of course the fso method has an isready property for drives. However, if the drive is not ready, I am not sure how you could get it ready.

My drives can vary so a pen drive as E: one day may be a G: on another.

GTO
04-02-2009, 12:25 AM
@ioncila:
Kenneth's excellent observations reference a pen/flash drive coming back as different (on the same machine) one day to the next make the testing moot. As an FYI only, the User Defined error was because I forgot to "back out" 'As FileSystemObject' (and etc) early-bound type references. These should have been 'As Object'.

@Ken:
Well, being a little thick-headed, I had just started to catch on as to the possibility of using other machines. The thought of the same machine returning a different letter one time to the next didn't even occur to me; so thank you much for that. :thumb

Also, after re-reading yours at #4, I thought to try plugging in various paths in tPaths, for instance:
tPaths = "L:\PASTA TÉCNICA Experiment\,H:\PASTA TÉCNICA Experiment\," & _
"D:\PASTA TÉCNICA Experiment\,G:\PASTA TÉCNICA Experiment\"

Where:
L:\ = network drive isready=false
(cliking on in win explorer results in aa msg ending: "this connection has not been restored"
H:\ = network drive isready=true
D:\ = cd-rom isready=false
G:\ = removable isready=true
(my flashdrive and I had created the folder and wb's being looked for in G:\ )

My observations were that if the various paths included two paths where isready would return false, the second one would fatal, giving err.num 52 / "Bad filename or number".

Now if there was only one path that isready=false, it would make it and (presuming G:\... is last test) find the path in G:\ . I also checked to see if it mattered as to order (check L:\.... first, then D:\... or visa-versa). In my admittedly limited testing capability (I could only find these two paths that would return isready=false), it did not seem to matter as to order or position in the checking.

I even threw in an Err.Clear right below "NextE:" (above Next e), alas no avail. (I do realize you already had an On Error GoTo, this was just the only thing I could think of left to try.) Do you observe the same, or am I missing something?

ioncila - you are welcome to try this, but you might want to wait and see til Malcom or Kenneth stop by, as they are both quite a bit more knowledgeable than yours truly here. Anyways - here's taking off on Malcom's in looping thru the available drives, while I think (or by this time, more like hope and pray) that this should loop only thru the removable drives that are ready.

Option Explicit

Private Enum DRIVE_STATUS
DRIVE_READY_EXISTSNOT = 1
DRIVE_READY_FALSE = 2
DRIVE_READY_TRUE = 3
End Enum

Private Function GetDriveStatus(ByRef fs As Object, _
ByVal Drive2Check As String) As DRIVE_STATUS
Dim fs_drv As Object 'Drive

'// Not necessary, as we're currently checking the Drives collection. I //
'// included in case of calling the function with a specified drive letter. //
Drive2Check = UCase(Drive2Check)
If Len(Drive2Check) = 1 Then Drive2Check = Drive2Check & Application.PathSeparator
'// SAA, but the above should be included if this is. //
If Not fs.DriveExists(Drive2Check) Then
GetDriveStatus = DRIVE_READY_EXISTSNOT
Exit Function
End If

Set fs_drv = fs.GetDrive( _
fs.GetDriveName( _
fs.GetAbsolutePathName(Drive2Check)))

If Not fs_drv.IsReady Then
GetDriveStatus = DRIVE_READY_FALSE
Else
GetDriveStatus = DRIVE_READY_TRUE
End If
End Function

Private Function PenDrive2(WBName As String) As Workbook
Dim fso As Object 'FileSystemObject
Dim f_drives As Object 'Drives
Dim f_drive As Object 'Drive

Const PATH_WB As String = "\PASTA TÉCNICA Experiment\"

Set fso = CreateObject("Scripting.FileSystemObject")
Set f_drives = fso.Drives

For Each f_drive In f_drives
'// We could skip looking in fixed/network drives by seeing if the drive is //
'// ready and the DriveType is removable (floppy/flash/CD) //
If GetDriveStatus(fso, f_drive) = DRIVE_READY_TRUE _
And f_drive.DriveType = 1 Then
'// Then check to see if the folder and file are there. //
If fso.FileExists(f_drive & PATH_WB & WBName) Then
Set PenDrive2 = Workbooks.Open(f_drive & PATH_WB & WBName)
Exit For
End If
End If
Next
End Function

A great day to all:) ,

Mark

GTO
04-02-2009, 04:38 AM
ACK! While not noticeable in current scenario, this line:

If Len(Drive2Check) = 1 Then Drive2Check = Drive2Check & Application.PathSeparator

...should read...

If Len(Drive2Check) = 1 Then Drive2Check = Drive2Check & ":"

oopsie...

Mark

Kenneth Hobs
04-02-2009, 09:46 AM
Similar to my other approach. FileIs() can be used as a UDF too. You could add or remove:
Application.Volatile True
If you wanted it to update at each calculation or not.

Sub Test_FileIs()
Dim pth As String, tPaths As String, fn As String, pf As String
fn = "Ken.xls"
pth = ":\Myfiles\Excel\" 'Prefix with :\ and suffix with \
pf = pth & fn
tPaths = "E" & pf & ",F" & pf & ",G" & pf & ",H" & pf & ",X" & pf & ",C" & pf
pf = FileIs(tPaths)
If pf = "NA" Then
MsgBox "No such filename exists as: " & vbCrLf & _
Replace(tPaths, ",", vbLf), vbCritical, "Error"
Exit Sub
End If
MsgBox pf, vbInformation, "Found a Path. Opening as a workbook now."
Workbooks.Open pf
End Sub

Function FileIs(tryPaths As String) As String
Dim a, e
Application.Volatile True
a = Split(tryPaths, ",")
For Each e In a
On Error GoTo NextE
e = Trim(e)
If Dir(e) <> "" Then
FileIs = e
Exit Function
End If
NextE:
Next e
FileIs = "NA"
End Function

ioncila
04-02-2009, 01:56 PM
Amazing!
Never thought that a question that was supposed to be simple could create a fantastic discussion.
Yes, all I have to do is wait because your tech level is much higher than mine.
But I'm paying all the attention. This is very much better than any course.

Thank you so much

ioncila

GTO
04-02-2009, 08:10 PM
Hey ioncila,

I certainly agree this got to be "livelier" than expected, but that is quite franky my faualt for being a bit slow in seeing the potential issues. Hopefully you'll post results after testing :-)

Mark