Solved: Path to macro

[ioncila]

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]

That would be pretty difficult I think but you can browse for the location:
[VBA]With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
If .Show = -1 Then
MsgBox .SelectedItems(1)
End If
End With[/VBA]

[mdmackillop]

This will show available Environ data. You could test for a suitable value and use that to set your path
[VBA]
Sub Details()
Dim i
For i = 1 To 50
Cells(i, 1) = Environ(i)
Next
End Sub

[/VBA]

[Kenneth Hobs]

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.
[vba]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[/vba]

[ioncila]

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]

[VBA]
'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

[/VBA]

[mdmackillop]

An alternative
[VBA]
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
[/VBA]

[ioncila]

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

[VBA]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[/VBA]

[mdmackillop]

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.

[vba]
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

[/vba]

[ioncila]

@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]

Looks like a Floppy Drive issue. We can skip over it
[VBA]
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

[/VBA]

[ioncila]

@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]

Sorry for insistance but the issue is still there, with the same msg

[mdmackillop]

Did you see my post 11?

[ioncila]

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]

I can't replicate this on my PC. Anyone else help?

[GTO]

...
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?

[vba]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[/vba]

Then the first few lines of as shown by Malcom at #9:
[vba]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...[/vba]

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]

Hi Mark,
I used "A:" in my code, does it work with "A"?

[GTO]

@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]

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