WK Pool

[kloosterofobie]

voetbalpool

Ik heb een wk pool opgezet. Maar ik zit nog met 3 vragen.

1 ik heb een macro gemaakt (laten maken door een tool van Ron de Bruin) Maar die werkt alleen op mijn computer

Private Sub CommandButton1_Click()

    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim wbname As String
    Application.ScreenUpdating = False
    Set wb1 = ActiveWorkbook
    wbname = "C:/" & wb1.Name & " " & _
    Format(Now, "dd-mm-yy h-mm-ss") & ".xls"
    wb1.SaveCopyAs wbname
    [U]Set wb2 = Workbooks.Open(wbname)[/U]
    With wb2
        .SendMail "inschrijven@wkpool2006.net", _
                  "Inschrijving WK Pool 2006"
        .ChangeFileAccess xlReadOnly
        Kill .FullName
        .Close False
    End With
    Application.ScreenUpdating = True

   
End Sub

Bij het onderstreepte geeft ie een fout.

2 op andere computers geeft hij aan dat er een verwijzing zit naar een ander document. Maar ik kan me niet heugen deze te hebben toegevoegd. Weet iemand een manier om snel in je werkboek te zoeken naar die betreffende cel.

3 Heeft iemand al een macro bedacht om alle uitslagen van binnegekomen documenten af te halen en in een hoofddocument te plaatsen. Anders moet ik zelf wat verzinnen.


BVD Jeroen

 

[jheesterbeek]

1. de macro verwijst naar een file op jou pc, deze is voor anderen dus niet benaderbaar
2. onder bewerken-koppelingen kun je de koppelingen naar andere files zien
3. met onderstaande macro kun je informatie uit verschillende files in een directory ophalen, wellicht kun je er iets mee:

Sub OpenEveryDirFile()
Dim strPath As String
Dim lFile As Long
Dim wkb As Workbook
Dim Source As String

Application.ScreenUpdating = False
'zoek de juiste map op
With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = Application.DefaultFilePath & "\"
    .Title = "Selecteer een folder"
    .Show
    If .SelectedItems.Count = 0 Then
        MsgBox ("Ophalen download-bestand gecanceled")
    Else
        strPath = .SelectedItems(1)
    End If
End With


With Application.FileSearch
.NewSearch
.LookIn = strPath
.SearchSubFolders = False
.MatchTextExactly = False
.FileType = msoFileTypeExcelWorkbooks
If .Execute() < 1 Then
MsgBox "There were no files found."
Exit Sub
End If

For lFile = 1 To .FoundFiles.Count
Set wkb = Workbooks.Open(Filename:=.FoundFiles(lFile), _
UpdateLinks:=False, ReadOnly:=True, _
IgnoreReadOnlyRecommended:=True)
' doe hier iets (een andere macro)
wkb.Close (False)
Next lFile
End With
Set wkb = Nothing

End Sub

 

[kloosterofobie]

Die macro van de mail is het de bedoeling dat deze een copy maakt op de C schijf van de deelnemer. En dat outlook daarna deze copy naar mij verstuurt.

 

[jheesterbeek]

ik heb het probleem ook niet, maar verwacht dat het met de instellingen van explorer te maken heeft. Hier kun je instellen of de extensie verbrogen moet worden. Verder stond er C:/ wat volgerns mij C:\ moet zijn.
Probeer onderstaande code eens:

    Dim wb1 As Workbook
    Dim wb2 As Workbook
    Dim wbname As String
    Application.ScreenUpdating = False
[B]    If Right(ActiveWorkbook, 4) = ".xls" Then
        Set wb1 = Left(ActiveWorkbook, Len(ActiveWorkbook) - 4)
    Else: Set wb1 = ActiveWorkbook
    End If[/B]    wbname = "[B]C:\[/B]" & wb1.Name & " " & _
    Format(Now, "dd-mm-yy h-mm-ss") & ".xls"
    wb1.SaveCopyAs wbname
    Set wb2 = Workbooks.Open(wbname)
    With wb2
        .SendMail "inschrijven@wkpool2006.net", _
                  "Inschrijving WK Pool 2006"
        .ChangeFileAccess xlReadOnly
        Kill .FullName
        .Close False
    End With
    Application.ScreenUpdating = True

 

[kloosterofobie]

Ik zal hem proberen.