help with network script...

[RompStar]

Ok, trying to build a script so that I can automatically as much as I
can import other excel files over the local //network/ to my local PC,
and I got it to work, if I specify the file name directly, but since
the file names changes on a daily basis, I wanted to have a pop-up box
so that I can tell excel what the file name is, since path\\ is alwayds
the same, but I am not sure if the InputBox resurns the value to sNew,
what am I doing wrong ?

Please, help...

---- start here script

Option Explicit

Sub appendfileovernetwork()

Dim networkPath As String
Dim sNew As String

' networkpath represents network \\PATH, always the same

networkPath = "\\network\path

' filename changes daily, file_4-1-2005.xls, file_4-2-2005.xls
' everyday it's different date, use pop-up box to ask for file name
' fileName = "*.xls"

On Error GoTo ERR_DISK
' Open WorkBook over network

Workbooks.Open fileName:=networkPath & sNew
' copy and paste
Workbooks(sNew).Names("Pick_Ups").RefersToRange.Copy _
ThisWorkbook.Worksheets("Import").Range("A65536").End(xlUp).Offset(1,
0)
' close network workbook
Workbooks(sNew).Close

Exit Sub

ERR_DISK:
If Err.Number = 1004 Then
sNew = InputBox("Can not open Excel file, please enter new file name:")

If sNew <> "" Then
Resume
Else
Exit Sub
End If
End If
End Sub

 

[Dave Peterson]

Personally, I don't like typing in the name of the file. I find it too
difficult to get correct (as a user!).

And as a developer, I'd have to verify that the file is there before I continue.

Maybe you could just show application.getopenfilename and have the user point to
the workbook that should be opened. Since the file is on a network drive,
you'll need an API function to change to that folder first.

Option Explicit
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub
Sub ExportEither()
Dim Resp As Long
Dim networkPath As String
Dim MyFileName As Variant
Dim CurDriveFolder As String
Dim newWkbk As Workbook
Dim testRange As Range

networkPath = "\\network\path\"

CurDriveFolder = CurDir

On Error Resume Next
ChDirNet networkPath
If Err.Number <> 0 Then
MsgBox "error changing folder"
Err.Clear
End If
On Error GoTo 0

MyFileName = Application.GetOpenFilename("Excel Files, *.xls")
If MyFileName = False Then
'do nothing, user hit cancel
Else
Set newWkbk = Workbooks.Open(Filename:=MyFileName)
Set testRange = Nothing
On Error Resume Next
Set testRange = newWkbk.Names("Pick_Ups").RefersToRange
On Error GoTo 0

If testRange Is Nothing Then
MsgBox "Pick_UPs wasn't found!"
Else
testRange.Copy _
Destination:=ThisWorkbook.Worksheets("Import") _
.Range("A65536").End(xlUp).Offset(1, 0)
End If

newWkbk.Close savechanges:=False

End If

ChDirNet CurDriveFolder

End Sub

 

[raymond m.]

wow

how long did it take you to get this good, I am just starting out to learn
VB ?

got about 2 weeks +/1 :- ) lo l

RompStar

 

[raymond m.]

so if I cut and paste this with some minor changes, it should work ?

do I need that API you mentioned, or does that comes with windows
default ? and if not, where do I download one from ?

thank you for your time and help...

RompStar

 

[Dave Peterson]

And if you're lucky (and your code worked ok before <vbg>), maybe no changes???

That API function is the one at the top:

So just include that in your copy|paste.

 

[Dave Peterson]

The bad news is that every day, you see so much more that you don't know.

The more you know, the more you know you don't know.

 

[RompStar]

you're a freaking genious! it worked perfectly, all I had to do was
change the PATHNAME\\

wow, thanks, I learned a lot and I hope other people watching this post
did as well..

Thank you!!!!!!!

 

[RompStar]

So now my goal is to fully understand this code and when I look at it a
lot of it makes sense right away to me, I have some BASIC knowhow and
ANSI C, but that's from like 8 years ago, and if u don't practice, you
forget.

So:

If testRange Is Nothing Then
MsgBox "Pick_UPs wasn't found!"
Else
testRange.Copy _
Destination:=ThisWorkbook.Worksheets("Import") _
..Range("A65536").End(xlUp).Offset(1, 0)
End If


Offset(1, 0) < ------ what does the (1, 0) do ?


Also from the "import" file over the network, how can I make it so to
instruct to ignore the first row, that has the column names, I want to
only get the raw data ? since I have the headers already...

Thank you.

 

[Dave Peterson]

Hey, that part of the code was yours!

..range("a65536") is the last cell in column A.
..end(xlup) is like hitting the end key followed by the up arrow (when you do it
manually).

so .range("a65536").end(xlup) will refer to the last filled in cell in column A.

..offset(1,0) means to come down one row, and over 0 columns.

so .range("a65536").end(xlup).offset(1,0) will refer to the next open cell after
the last filled cell.

..offset(x,y) can take positive and negative numbers, too.

.range("e9").offset(-2,-4)
will point at two rows up and 4 rows to the left. If I did my math correctly,
it points at A7.

===
So you want to avoid the first row of the "pick_ups" range?

You can use that .offset() and .resize() (resize says to, er, make it a
different size--one row smaller in this case.

Option Explicit
Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long
Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub
Sub ExportEither()
Dim Resp As Long
Dim networkPath As String
Dim MyFileName As Variant
Dim CurDriveFolder As String
Dim newWkbk As Workbook
Dim testRange As Range

networkPath = "\\network\path\"

CurDriveFolder = CurDir

On Error Resume Next
ChDirNet networkPath
If Err.Number <> 0 Then
MsgBox "error changing folder"
Err.Clear
End If
On Error GoTo 0

MyFileName = Application.GetOpenFilename("Excel Files, *.xls")
If MyFileName = False Then
'do nothing, user hit cancel
Else
Set newWkbk = Workbooks.Open(Filename:=MyFileName)
Set testRange = Nothing
On Error Resume Next
Set testRange = newWkbk.Names("Pick_Ups").RefersToRange
On Error GoTo 0

If testRange Is Nothing Then
MsgBox "Pick_UPs wasn't found!"
Else
If testRange.Rows.Count < 2 Then
MsgBox "Only Headers!"
Else
With testRange
.Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0).Copy _
Destination:=ThisWorkbook.Worksheets("Import") _
.Range("A65536").End(xlUp).Offset(1, 0)
End With
End If
End If

newWkbk.Close savechanges:=False

End If

ChDirNet CurDriveFolder

End Sub

Here's that .resize() portion:

With testRange
.Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0)

Make it one row smaller, but the same number of columns. Then come down one 1
row, but stay in the same column.

Pretty neat stuff, huh?

 

[RompStar]

thanks..

the previous code was cut and paste from various books and other code
that I seen on the
net, but understood majority of it, but I want to understand more :- )
then just majority of it.

what I would like to understand next is this:

there are 2 subroutines in the total script ?

Sub ChDirNet(szPath As String)
Dim lReturn As Long
lReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting
path."
End Sub

The Dim IReturn As Long, that's Declaring a Variable.

the rest looks familiar, but I want to be sure :- )

again, your time and kind explanations are appeciated.

 

[Dave Peterson]

Yep. Two Sub routines and one function.

That ChDirNet is a nice little subroutine that calls that function.

And one more thing... If you're not sure what you're doing (or what your code
will do), make sure you do a save first (or close without saving after).

VBA is fun when you don't have tears in your eyes from destroying your data or
your code!

 

[RompStar]

hahaha, so I see :- )

I am reading books for beginners, so this all makes more sense
to me on a daily basis...

well, I think next I would want to learn how to rearrange the columns
that
are transfered, there are 15 of them, A - O, when they are imported
from
" Pick_Ups", there are some columns that aren't really needed, so some
I would like to learn how to drop ? can that be done in excel, I think
so :- )

So I guess after figuring out which ones to drop, next I have to figure
out how to
arrange the columns in the order I want and then paste them, and of
course I want it to
append the existing data from previous imports. I guess I would do
this by the column header names ? to select the columns or by column
numbers ?

 

[Dave Peterson]

I think I'd import all the data (just like you're doing it now).

But when you're done with the import, you can record a macro when you
delete/move/cut/copy/paste columns.

Then just add a call to that procedure to the end of your macro.

 

[RompStar]

sounds great :- )

let me research that and work on it, I'll report back later and show
what I did...

 

[RompStar]

question:

In the "Import" local sheet, say I want to be already an existing
column A (Receive Date) and the "Pick_Ups" should be pasted starting in
column B of"Import", because column A will contain dates that will be
entered manually by the user on that date.

..offset(0, 1) does this, but if I run the script again it doesn't
append, instead
it replaces the sheet with new data, it doesn't append, any ideas ?

I know how to protect a column, but is that what I will need to do, or
will that
be a problem for the script ?

 

[RompStar]

ahhh this worked :- )

Range("B65536").End(xlUp).Offset(0, 0)

learning...

 

[Dave Peterson]

If you know your data, I find picking a column best. (Just what you found).

but why not
range("b65536").end(xlup).offset(1,0)

 

[RompStar]

the (1,0) inserts a blank row space in the top row, not the second time
I run it to append, but the first...

 

[RompStar]

hey,

newWkbk.Close savechanges:=False

is that for the "Import" workbook ? and if so, if I change that to True
then the "Import" should be saved automatically after import ?

is that right ?

 

[RompStar]

I tried to edit the testRange to include that procedue to ignore
new imports only with headers, but when I, Debud, Compile VBA Project,
I get an error: End If without block If, I looked at it and not sure
where
the problem is ?

Can you help ?

here is the script as it stands now...

start ----

Option Explicit

Private Declare Function SetCurrentDirectoryA Lib _
"kernel32" (ByVal lpPathName As String) As Long

Sub ChDirNet(szPath As String)
Dim lReturn As Long
IReturn = SetCurrentDirectoryA(szPath)
If lReturn = 0 Then Err.Raise vbObjectError + 1, "Error setting path."
End Sub

Sub ImportRetroBoxDailyFiles()
Dim Resp As Long
Dim networkPath As String
Dim MyFileName As Variant
Dim CurDriveFolder As String
Dim newWkbk As Workbook
Dim testRange As Range

networkPath = "\\\HARDWARE\Requests\test_network_append\"

CurDriveFolder = CurDir

On Error Resume Next
ChDirNet networkPath
If Err.Number <> 0 Then
MsgBox "error changing folder"
Err.Clear
End If
On Error GoTo 0

MyFileName = Application.GetOpenFilename("Excel Files, *.xls")
If MyFileName = False Then
'do nothing, user hit cancel
Else
Set newWkbk = Workbooks.Open(fileName:=MyFileName)
Set testRange = Nothing
On Error Resume Next
Set testRange = newWkbk.Names("Pick_Ups").RefersToRange
On Error GoTo 0

If testRange.Rows.Count < 2 Then 'if less then 2 rows, must be only
headers, ignore
MsgBox "Only Headers!" ' pop-up a box is only headers found
Else
With testRange
..Resize(.Rows.Count - 1, .Columns.Count).Offset(1, 0).Copy _
Destination:=ThisWorkbook.Worksheets("Import").Range("B65536").End(xlUp).Offset(0,
0)
End

End If
End If

newWkbk.Close savechanges:=False

End If

ChDirNet CurDriveFolder

End Sub

--- end

Did I add your idea there correct ? for the header check ?